Bump version to 0.9

Most signifigant changes are use unversioned links to external html,
fix a couple of key binding examples, and double quotes that should
have been single.

README

@@ -1,21 +1,78 @@
-3rd party xmonad extensions and contributions.
+  xmonad-contrib : third party extensions to the xmonad window manager
 
-Build and install through Cabal as for other Haskell packages:
+                           http://xmonad.org
 
-        runhaskell Setup configure --user --prefix=$HOME
-        runhaskell Setup build
-        runhaskell Setup install --user
+    You need the ghc compiler and xmonad window manager installed in
+    order to use these extensions.
 
-(You may want to remove the --user flag when installing as root.)
+    For installation and configuration instructions, please see the
+    xmonad website, the documents included with the xmonad source
+    distribution, and online haddock documentation:
 
-scripts/ contains further external programs useful with xmonad.
+    http://www.xmonad.org/xmonad-docs
 
-Haskell code contributed to this repo should live under the
-appropriate subdivision of the 'XMonad.' namespace (currently includes
-Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use
-the Mosaic layout, one would import:
+------------------------------------------------------------------------
 
- XMonad.Layout.Mosaic
+Changelogs
+
+    For a list of changes since the 0.8.x releases, see:
+
+http://www.haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8
+
+------------------------------------------------------------------------
+
+Updates to XMonadContrib-0.9 that may Require Changes to ~/.xmonad/xmonad.hs
+
+    Please see the Changelogs and xmonad-contrib haddock documentation
+    links for further details regarding the following changes.
+
+    * XMonad.Hooks.EwmhDesktops no longer uses layoutHook, the
+    ewmhDesktopsLayout modifier has been removed from xmonad-contrib. It
+    uses logHook, handleEventHook, and startupHook instead and provides
+    a convenient function 'ewmh' to add EWMH support to a defaultConfig.
+
+    * Most DynamicLog users can continue with configs unchanged, but users
+    of the quickbar functions 'xmobar' or 'dzen' will need to change
+    xmonad.hs: their types have changed to allow easier composition with
+    other XConfig modifiers. The 'dynamicLogDzen' and 'dynamicLogXmobar'
+    functions have been removed.
+
+    * WindowGo or safeSpawn users may need to change command lines due to
+    safeSpawn changes.
+
+    * People explicitly referencing the "SP" scratchpad workspace should
+    change it to "NSP" which is also used by the new Util.NamedScratchpad.
+
+    * (Optional) People who explicitly use swapMaster in key or mouse
+    bindings should change it to shiftMaster. It's the current default
+    used where swapMaster had been used previously. It works better than
+    swapMaster when using floating and tiled windows together on the
+    same workspace.
+
+------------------------------------------------------------------------
+
+Getting or updating XMonadContrib
+
+    latest release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib
+
+    darcs version:  darcs get http://code.haskell.org/XMonadContrib
+
+    (To use darcs xmonad-contrib you must also use the darcs version
+    of xmonad.)
+
+------------------------------------------------------------------------
+
+Contributing
+
+    Haskell code contributed to this repo should live under the
+    appropriate subdivision of the 'XMonad.' namespace (currently
+    includes Actions, Config, Hooks, Layout, Prompt, and Util). For
+    example, to use the Grid layout, one would import:
+
+        XMonad.Layout.Grid
+
+    For further details, see the documentation for the
+    XMonad.Doc.Developing module and http://xmonad.org website.
 
 ------------------------------------------------------------------------
 
@@ -23,6 +80,3 @@ Code submitted to the contrib repo is licensed under the same license as
 xmonad itself, with copyright held by the authors.
 
 ------------------------------------------------------------------------
-
-Documentation for the extensions and configuration system is available
-in Haddock form in the XMonad.Doc module and submodules.

XMonad/Actions/Commands.hs

@@ -41,16 +41,16 @@ import Data.Maybe
 --
 -- Then add a keybinding to the runCommand action:
 --
--- >    , ((modMask x .|. controlMask, xK_y), runCommand commands)
+-- >    , ((modm .|. controlMask, xK_y), commands >>= runCommand)
 --
 -- and define the list of commands you want to use:
 --
--- >    commands :: [(String, X ())]
+-- >    commands :: X [(String, X ())]
 -- >    commands = defaultCommands
 --
 -- Whatever key you bound to will now cause a popup menu of internal
--- xmonad commands to appear.  You can change the commands by
--- changing the contents of the list 'commands'.  (If you like it
+-- xmonad commands to appear.  You can change the commands by changing
+-- the contents of the list returned by 'commands'.  (If you like it
 -- enough, you may even want to get rid of many of your other key
 -- bindings!)
 --
@@ -82,23 +82,22 @@ defaultCommands = do
     wscmds <- workspaceCommands
     return $ wscmds ++ screenCommands ++ otherCommands
  where
-    sr = broadcastMessage ReleaseResources
     otherCommands =
         [ ("shrink"              , sendMessage Shrink                               )
         , ("expand"              , sendMessage Expand                               )
         , ("next-layout"         , sendMessage NextLayout                           )
         , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )
-        , ("restart-wm"          , sr >> restart Nothing True                       )
-        , ("restart-wm-no-resume", sr >> restart Nothing False                      )
+        , ("restart-wm"          , restart "xmonad" True                            )
+        , ("restart-wm-no-resume", restart "xmonad" False                           )
         , ("xterm"               , spawn =<< asks (terminal .  config)              )
         , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )
         , ("kill"                , kill                                             )
         , ("refresh"             , refresh                                          )
-        , ("focus-up"            , windows $ focusUp                                )
-        , ("focus-down"          , windows $ focusDown                              )
-        , ("swap-up"             , windows $ swapUp                                 )
-        , ("swap-down"           , windows $ swapDown                               )
-        , ("swap-master"         , windows $ swapMaster                             )
+        , ("focus-up"            , windows focusUp                                  )
+        , ("focus-down"          , windows focusDown                                )
+        , ("swap-up"             , windows swapUp                                   )
+        , ("swap-down"           , windows swapDown                                 )
+        , ("swap-master"         , windows swapMaster                               )
         , ("sink"                , withFocused $ windows . sink                     )
         , ("quit-wm"             , io $ exitWith ExitSuccess                        )
         ]

XMonad/Actions/ConstrainedResize.hs

@@ -5,7 +5,7 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  <dougal@dougalstanton.net>
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- Lets you constrain the aspect ratio of a floating
@@ -16,9 +16,9 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.ConstrainedResize (
-	-- * Usage
-	-- $usage
-	XMonad.Actions.ConstrainedResize.mouseResizeWindow
+        -- * Usage
+        -- $usage
+        XMonad.Actions.ConstrainedResize.mouseResizeWindow
 ) where
 
 import XMonad
@@ -31,8 +31,8 @@ import XMonad
 --
 -- Then add something like the following to your mouse bindings:
 --
--- >     , ((modMask x, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))
--- >     , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))
+-- >     , ((modm, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))
+-- >     , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))
 --
 -- The line without the shiftMask replaces the standard mouse resize
 -- function call, so it's not completely necessary but seems neater
@@ -53,5 +53,5 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
                      y = ey - fromIntegral (wa_y wa)
                      sz = if c then (max x y, max x y) else (x,y)
                  io $ resizeWindow d w `uncurry`
-                    applySizeHints sh sz)
+                    applySizeHintsContents sh sz)
               (float w)

XMonad/Actions/CopyWindow.hs

@@ -1,15 +1,15 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE PatternGuards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CopyWindow
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  ???
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Provides a binding to duplicate a window on multiple workspaces,
+-- Provides bindings to duplicate a window on multiple workspaces,
 -- providing dwm-like tagging functionality.
 --
 -----------------------------------------------------------------------------
@@ -17,13 +17,20 @@
 module XMonad.Actions.CopyWindow (
                                  -- * Usage
                                  -- $usage
-                                 copy, copyWindow, kill1
+                                 copy, copyToAll, copyWindow, runOrCopy
+                                 , killAllOtherCopies, kill1
+                                 -- * Highlight workspaces containing copies in logHook
+                                 -- $logHook
+                                 , wsContainingCopies
                                 ) where
 
-import Prelude hiding ( filter )
+import XMonad
+import Control.Arrow ((&&&))
+import Control.Monad
 import qualified Data.List as L
-import XMonad hiding (modify)
-import XMonad.StackSet
+
+import XMonad.Actions.WindowGo
+import qualified XMonad.StackSet as W
 
 -- $usage
 --
@@ -36,7 +43,7 @@ import XMonad.StackSet
 -- > -- mod-[1..9] @@ Switch to workspace N
 -- > -- mod-shift-[1..9] @@ Move client to workspace N
 -- > -- mod-control-shift-[1..9] @@ Copy client to workspace N
--- > [((m .|. modMask x, k), windows $ f i)
+-- > [((m .|. modm, k), windows $ f i)
 -- >     | (i, k) <- zip (workspaces x) [xK_1 ..]
 -- >     , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]]
 --
@@ -48,38 +55,110 @@ import XMonad.StackSet
 -- You may also wish to redefine the binding to kill a window so it only
 -- removes it from the current workspace, if it's present elsewhere:
 --
--- >  , ((modMask x .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
+-- >  , ((modm .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
+--
+-- Instead of copying a window from one workspace to another maybe you don't
+-- want to have to remember where you placed it.  For that consider:
+--
+-- >  , ((modm, xK_b    ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox
+--
+-- Another possibility which this extension provides is 'making window
+-- always visible' (i.e. always on current workspace), similar to corresponding
+-- metacity functionality. This behaviour is emulated through copying given
+-- window to all the workspaces and then removing it when it's unneeded on
+-- all workspaces any more.
+--
+-- Here is the example of keybindings which provide these actions:
+--
+-- >  , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible
+-- >  , ((modm .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
--- | copy. Copy the focussed window to a new workspace.
-copy :: WorkspaceId -> WindowSet -> WindowSet
-copy n s | Just w <- peek s = copyWindow w n s
+-- $logHook
+-- To distinguish workspaces containing copies of the focused window use
+-- something like:
+--
+-- > sampleLogHook h = do
+-- >    copies <- wsContainingCopies
+-- >    let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws
+-- >                 | otherwise = pad ws
+-- >    dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h}
+-- >
+-- > main = do
+-- >    h <- spawnPipe "xmobar"
+-- >    xmonad defaultConfig { logHook = sampleLogHook h }
+
+-- | Copy the focused window to a workspace.
+copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
+copy n s | Just w <- W.peek s = copyWindow w n s
          | otherwise = s
 
--- | copyWindow.  Copy a window to a new workspace
-copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet
-copyWindow w n = copy'
-    where copy' s = if n `tagMember` s
-                    then view (tag (workspace (current s))) $ insertUp' w $ view n s
-                    else s
-          insertUp' a s = modify (Just $ Stack a [] [])
-                          (\(Stack t l r) -> if a `elem` t:l++r
-                                             then Just $ Stack t l r
-                                             else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s
+-- | Copy the focused window to all workspaces.
+copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
+copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
 
+-- | Copy an arbitrary window to a workspace.
+copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
+copyWindow w n = copy'
+    where copy' s = if n `W.tagMember` s
+                    then W.view (W.currentTag s) $ insertUp' w $ W.view n s
+                    else s
+          insertUp' a s = W.modify (Just $ W.Stack a [] [])
+                          (\(W.Stack t l r) -> if a `elem` t:l++r
+                                             then Just $ W.Stack t l r
+                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s
+
+
+-- | runOrCopy will run the provided shell command unless it can
+--  find a specified window in which case it will copy the window to
+--  the current workspace.  Similar to (i.e., stolen from) "XMonad.Actions.WindowGo".
+runOrCopy :: String -> Query Bool -> X ()
+runOrCopy = copyMaybe . spawn
+
+-- | Copy a window if it exists, run the first argument otherwise.
+copyMaybe :: X () -> Query Bool -> X ()
+copyMaybe f qry = ifWindow qry copyWin f
+    where copyWin = ask >>= \w -> doF (\ws -> copyWindow w (W.currentTag ws) ws)
 
 -- | Remove the focused window from this workspace.  If it's present in no
 -- other workspace, then kill it instead. If we do kill it, we'll get a
 -- delete notify back from X.
 --
 -- There are two ways to delete a window. Either just kill it, or if it
--- supports the delete protocol, send a delete event (e.g. firefox)
---
+-- supports the delete protocol, send a delete event (e.g. firefox).
 kill1 :: X ()
 kill1 = do ss <- gets windowset
-           whenJust (peek ss) $ \w -> if member w $ delete'' w ss
+           whenJust (W.peek ss) $ \w -> if W.member w $ delete'' w ss
                                       then windows $ delete'' w
                                       else kill
-    where delete'' w = modify Nothing (filter (/= w))
+    where delete'' w = W.modify Nothing (W.filter (/= w))
+
+-- | Kill all other copies of focused window (if they're present).
+-- 'All other' means here 'copies which are not on the current workspace'.
+killAllOtherCopies :: X ()
+killAllOtherCopies = do ss <- gets windowset
+                        whenJust (W.peek ss) $ \w -> windows $
+                                                   W.view (W.currentTag ss) .
+                                                   delFromAllButCurrent w
+    where
+      delFromAllButCurrent w ss = foldr ($) ss $
+                                  map (delWinFromWorkspace w . W.tag) $
+                                  W.hidden ss ++ map W.workspace (W.visible ss)
+      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid
+
+-- | A list of hidden workspaces containing a copy of the focused window.
+wsContainingCopies :: X [WorkspaceId]
+wsContainingCopies = do
+    ws <- gets windowset
+    return $ copiesOfOn (W.peek ws) (taggedWindows $ W.hidden ws)
+
+-- | Get a list of tuples (tag, [Window]) for each workspace.
+taggedWindows :: [W.Workspace i l a] -> [(i, [a])]
+taggedWindows = map $ W.tag &&& W.integrate' . W.stack
+
+-- | Get tags with copies of the focused window (if present.)
+copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i]
+copiesOfOn foc tw = maybe [] hasCopyOf foc
+  where hasCopyOf f = map fst $ filter ((f `elem` ) . snd) tw

XMonad/Actions/CycleRecentWS.hs

@@ -0,0 +1,85 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleRecentWS
+-- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Michal Janeczek <janeczek@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to cycle through most recently used workspaces
+-- with repeated presses of a single key (as long as modifier key is
+-- held down). This is similar to how many window managers handle
+-- window switching.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleRecentWS (
+                                -- * Usage
+                                -- $usage
+                                cycleRecentWS,
+                                cycleWindowSets
+) where
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleRecentWS
+-- >
+-- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Cycle through most recent workspaces with repeated presses of a key, while
+--   a modifier key is held down. The recency of workspaces previewed while browsing
+--   to the target workspace is not affected. That way a stack of most recently used
+--   workspaces is maintained, similarly to how many window managers handle window
+--   switching. For best effects use the same modkey+key combination as the one used
+--   to invoke this action.
+cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                          --   As soon as one of them is released, the final switch is made.
+              -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
+              -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
+                          --   If it's the same as the nextWorkspace key, it is effectively ignored.
+              -> X ()
+cycleRecentWS = cycleWindowSets options
+ where options w = map (view `flip` w) (recentTags w)
+       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
+
+
+cycref :: [a] -> Int -> a
+cycref l i = l !! (i `mod` length l)
+
+-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
+--   a modifier key is held down. For best effects use the same modkey+key combination
+--   as the one used to invoke this action.
+cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
+                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.
+                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.
+                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options
+                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.
+                                              --   If it's the same as nextOption key, it is effectively ignored.
+                -> X ()
+cycleWindowSets genOptions mods keyNext keyPrev = do
+  options <- gets $ genOptions . windowset
+  XConf {theRoot = root, display = d} <- ask
+  let event = allocaXEvent $ \p -> do
+                maskEvent d (keyPressMask .|. keyReleaseMask) p
+                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                s <- keycodeToKeysym d c 0
+                return (t, s)
+  let setOption n = do windows $ const $ options `cycref` n
+                       (t, s) <- io event
+                       case () of
+                         () | t == keyPress   && s == keyNext  -> setOption (n+1)
+                            | t == keyPress   && s == keyPrev  -> setOption (n-1)
+                            | t == keyRelease && s `elem` mods -> return ()
+                            | otherwise                        -> setOption n
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+  setOption 0
+  io $ ungrabKeyboard d currentTime

XMonad/Actions/CycleSelectedLayouts.hs

@@ -0,0 +1,51 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleSelectedLayouts
+-- Copyright   :  (c) Roman Cheplyaka
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module allows to cycle through the given subset of layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleSelectedLayouts (
+    -- * Usage
+    -- $usage
+    cycleThroughLayouts) where
+
+import XMonad
+import Data.List (findIndex)
+import Data.Maybe (fromMaybe)
+import XMonad.Layout.LayoutCombinators (JumpToLayout(..))
+import qualified XMonad.StackSet as S
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad hiding ((|||))
+-- > import XMonad.Layout.LayoutCombinators ((|||))
+-- > import XMonad.Actions.CycleSelectedLayouts
+--
+-- >   , ((modm,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])
+--
+-- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,
+-- rather than the Select defined in xmonad core.
+
+cycleToNext :: (Eq a) => [a] -> a -> Maybe a
+cycleToNext lst a = do
+    -- not beautiful but simple and readable
+    ind <- findIndex (a==) lst
+    return $ lst !! if ind == length lst - 1 then 0 else ind+1
+
+-- | If the current layout is in the list, cycle to the next layout. Otherwise,
+--   apply the first layout from list.
+cycleThroughLayouts :: [String] -> X ()
+cycleThroughLayouts lst = do
+    winset <- gets windowset
+    let ld = description . S.layout . S.workspace . S.current $ winset
+    let newld = fromMaybe (head lst) (cycleToNext lst ld)
+    sendMessage $ JumpToLayout newld

XMonad/Actions/CycleWS.hs

@@ -9,68 +9,181 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Provides bindings to cycle forward or backward through the list
--- of workspaces, and to move windows there.
+-- Provides bindings to cycle forward or backward through the list of
+-- workspaces, to move windows between workspaces, and to cycle
+-- between screens.  More general combinators provide ways to cycle
+-- through workspaces in various orders, to only cycle through some
+-- subset of workspaces, and to cycle by more than one workspace at a
+-- time.
+--
+-- Note that this module now subsumes the functionality of the former
+-- @XMonad.Actions.RotView@.  Former users of @rotView@ can simply replace
+-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.
+--
+-- If you want to exactly replicate the action of @rotView@ (cycling
+-- through workspace in order lexicographically by tag, instead of in
+-- the order specified in the config), it can be implemented as:
+--
+-- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1
+-- >                 windows . greedyView $ t
+-- >   where bToDir True  = Next
+-- >         bToDir False = Prev
 --
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.CycleWS (
-                              -- * Usage
-                              -- $usage
-                              nextWS,
-                              prevWS,
-                              shiftToNext,
-                              shiftToPrev,
-                              toggleWS,
+                                -- * Usage
+                                -- $usage
+
+                                -- * Moving between workspaces
+                                -- $moving
+
+                                nextWS
+                              , prevWS
+                              , shiftToNext
+                              , shiftToPrev
+
+                                -- * Toggling the previous workspace
+                                -- $toggling
+                              , toggleWS
+                              , toggleOrView
+
+                                -- * Moving between screens (xinerama)
+
+                              , nextScreen
+                              , prevScreen
+                              , shiftNextScreen
+                              , shiftPrevScreen
+                              , swapNextScreen
+                              , swapPrevScreen
+
+                                -- * Moving between workspaces, take two!
+                                -- $taketwo
+
+                              , Direction1D(..)
+                              , WSType(..)
+
+                              , shiftTo
+                              , moveTo
+
+                                -- * The mother-combinator
+
+                              , findWorkspace
+                              , toggleOrDoSkip
+                              , skipTags
+
                              ) where
 
-import Data.List ( sortBy, findIndex )
-import Data.Maybe ( fromMaybe )
-import Data.Ord ( comparing )
+import Control.Monad ( unless )
+import Data.List ( findIndex )
+import Data.Maybe ( isNothing, isJust )
 
 import XMonad hiding (workspaces)
-import qualified XMonad (workspaces)
 import XMonad.StackSet hiding (filter)
+import XMonad.Util.Types
+import XMonad.Util.WorkspaceCompare
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CycleWS
---
--- >   , ((modMask x,               xK_Right), nextWS)
--- >   , ((modMask x,               xK_Left),  prevWS)
--- >   , ((modMask x .|. shiftMask, xK_Right), shiftToNext)
--- >   , ((modMask x .|. shiftMask, xK_Left),  shiftToPrev)
--- >   , ((modMask x,               xK_t),     toggleWS)
+-- >
+-- > -- a basic CycleWS setup
+-- >
+-- >   , ((modm,               xK_Down),  nextWS)
+-- >   , ((modm,               xK_Up),    prevWS)
+-- >   , ((modm .|. shiftMask, xK_Down),  shiftToNext)
+-- >   , ((modm .|. shiftMask, xK_Up),    shiftToPrev)
+-- >   , ((modm,               xK_Right), nextScreen)
+-- >   , ((modm,               xK_Left),  prevScreen)
+-- >   , ((modm .|. shiftMask, xK_Right), shiftNextScreen)
+-- >   , ((modm .|. shiftMask, xK_Left),  shiftPrevScreen)
+-- >   , ((modm,               xK_z),     toggleWS)
 --
 -- If you want to follow the moved window, you can use both actions:
 --
--- >   , ((modMask x .|. shiftMask, xK_Right), shiftToNext >> nextWS)
--- >   , ((modMask x .|. shiftMask, xK_Left),  shiftToPrev >> prevWS)
+-- >   , ((modm .|. shiftMask, xK_Down), shiftToNext >> nextWS)
+-- >   , ((modm .|. shiftMask, xK_Up),   shiftToPrev >> prevWS)
+--
+-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
+-- For example:
+--
+-- >   , ((modm     , xK_f), moveTo Next EmptyWS)  -- find a free workspace
+-- >   , ((modm .|. controlMask, xK_Right),        -- a crazy keybinding!
+-- >         do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2
+-- >            windows . view $ t                                         )
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+{- $moving
 
--- | Switch to next workspace
+The following commands for moving the view and windows between
+workspaces are somewhat inflexible, but are very simple and probably
+Do The Right Thing for most users.
+
+All of the commands in this section cycle through workspaces in the
+order in which they are given in your config.
+
+-}
+
+-- | Switch to the next workspace.
 nextWS :: X ()
 nextWS = switchWorkspace 1
 
--- | Switch to previous workspace
+-- | Switch to the previous workspace.
 prevWS :: X ()
 prevWS = switchWorkspace (-1)
 
--- | Move focused window to next workspace
+-- | Move the focused window to the next workspace.
 shiftToNext :: X ()
 shiftToNext = shiftBy 1
 
--- | Move focused window to previous workspace
+-- | Move the focused window to the previous workspace.
 shiftToPrev :: X ()
 shiftToPrev = shiftBy (-1)
 
--- | Toggle to the workspace displayed previously
+-- $toggling
+
+-- | Toggle to the workspace displayed previously.
 toggleWS :: X ()
-toggleWS = windows $ view =<< tag . head . hidden
+toggleWS = do
+    hs <- gets (hidden . windowset)
+    unless (null hs) (windows . view . tag $ head hs)
+
+-- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view
+-- the previously displayed workspace ala weechat. Change @greedyView@ to
+-- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view'
+-- faq at <http://haskell.org/haskellwiki/Xmonad/Frequently_asked_questions>.
+-- For more flexibility see 'toggleOrDoSkip'.
+toggleOrView :: WorkspaceId -> X ()
+toggleOrView = toggleOrDoSkip [] greedyView
+
+-- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while
+-- finding the previously displayed workspace, or choice of different actions,
+-- like view, shift, etc.  For example:
+--
+-- > import qualified XMonad.StackSet as W
+-- > import XMonad.Actions.CycleWS
+-- >
+-- > -- toggleOrView for people who prefer view to greedyView
+-- > toggleOrView' = toggleOrDoSkip [] W.view
+-- >
+-- > -- toggleOrView ignoring scratchpad and named scratchpad workspace
+-- > toggleOrViewNoSP = toggleOrDoSkip ["NSP"] W.greedyView
+toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
+                                  -> WorkspaceId -> X ()
+toggleOrDoSkip skips f toWS = do
+    ws <- gets windowset
+    let hs' = hidden ws `skipTags` skips
+    if toWS == (tag . workspace $ current ws)
+        then unless (null hs') (windows . f . tag $ head hs')
+        else windows (f toWS)
+
+-- | List difference ('\\') for workspaces and tags. Removes workspaces
+-- matching listed tags from the given workspace list.
+skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a]
+skipTags wss ids = filter ((`notElem` ids) . tag) wss
 
 switchWorkspace :: Int -> X ()
 switchWorkspace d = wsBy d >>= windows . greedyView
@@ -79,16 +192,146 @@ shiftBy :: Int -> X ()
 shiftBy d = wsBy d >>= windows . shift
 
 wsBy :: Int -> X (WorkspaceId)
-wsBy d = do
-    ws <- gets windowset
-    spaces <- asks (XMonad.workspaces . config)
-    let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws)
-    let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs
-    let next = orderedWs !! ((now + d) `mod` length orderedWs)
-    return $ tag next
+wsBy = findWorkspace getSortByIndex Next AnyWS
 
-wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int
-wsIndex spaces ws = findIndex (== tag ws) spaces
+{- $taketwo
+
+A few more general commands are also provided, which allow cycling
+through subsets of workspaces.
+
+For example,
+
+>   moveTo Next EmptyWS
+
+will move to the first available workspace with no windows, and
+
+>   shiftTo Prev (WSIs $ return (('p' `elem`) . tag))
+
+will move the focused window backwards to the first workspace containing
+the letter 'p' in its name. =)
+
+-}
+
+-- | What type of workspaces should be included in the cycle?
+data WSType = EmptyWS     -- ^ cycle through empty workspaces
+            | NonEmptyWS  -- ^ cycle through non-empty workspaces
+            | HiddenWS    -- ^ cycle through non-visible workspaces
+            | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces
+            | AnyWS       -- ^ cycle through all workspaces
+            | WSIs (X (WindowSpace -> Bool))
+                          -- ^ cycle through workspaces satisfying
+                          --   an arbitrary predicate
+
+-- | Convert a WSType value to a predicate on workspaces.
+wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
+wsTypeToPred EmptyWS    = return (isNothing . stack)
+wsTypeToPred NonEmptyWS = return (isJust . stack)
+wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)
+                             return (\w -> tag w `elem` hs)
+wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS
+                                    hi <- wsTypeToPred HiddenWS
+                                    return (\w -> hi w && ne w)
+wsTypeToPred AnyWS      = return (const True)
+wsTypeToPred (WSIs p)   = p
+
+-- | View the next workspace in the given direction that satisfies
+--   the given condition.
+moveTo :: Direction1D -> WSType -> X ()
+moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
+
+-- | Move the currently focused window to the next workspace in the
+--   given direction that satisfies the given condition.
+shiftTo :: Direction1D -> WSType -> X ()
+shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
+
+-- | Given a function @s@ to sort workspaces, a direction @dir@, a
+--   predicate @p@ on workspaces, and an integer @n@, find the tag of
+--   the workspace which is @n@ away from the current workspace in
+--   direction @dir@ (wrapping around if necessary), among those
+--   workspaces, sorted by @s@, which satisfy @p@.
+--
+--   For some useful workspace sorting functions, see
+--   "XMonad.Util.WorkspaceCompare".
+--
+--   For ideas of what to do with a workspace tag once obtained, note
+--   that 'moveTo' and 'shiftTo' are implemented by applying @(>>=
+--   (windows . greedyView))@ and @(>>= (windows . shift))@, respectively,
+--   to the output of 'findWorkspace'.
+findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
+findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
+  where
+    maybeNegate Next d = d
+    maybeNegate Prev d = (-d)
+
+findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
+findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
+findWorkspaceGen sortX wsPredX d = do
+    wsPred <- wsPredX
+    sort   <- sortX
+    ws     <- gets windowset
+    let cur     = workspace (current ws)
+        sorted  = sort (workspaces ws)
+        pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
+        ws'     = filter wsPred pivoted
+        mCurIx  = findWsIndex cur ws'
+        d'      = if d > 0 then d - 1 else d
+        next    = if null ws'
+                      then cur
+                      else case mCurIx of
+                            Nothing -> ws' !! (d' `mod` length ws')
+                            Just ix -> ws' !! ((ix + d) `mod` length ws')
+    return $ tag next
 
 findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
 findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
+
+-- | View next screen
+nextScreen :: X ()
+nextScreen = switchScreen 1
+
+-- | View prev screen
+prevScreen :: X ()
+prevScreen = switchScreen (-1)
+
+switchScreen :: Int -> X ()
+switchScreen d = do s <- screenBy d
+                    mws <- screenWorkspace s
+                    case mws of
+                         Nothing -> return ()
+                         Just ws -> windows (view ws)
+
+screenBy :: Int -> X (ScreenId)
+screenBy d = do ws <- gets windowset
+                --let ss = sortBy screen (screens ws)
+                let now = screen (current ws)
+                return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws))
+
+-- | Swap current screen with next screen
+swapNextScreen :: X ()
+swapNextScreen = swapScreen 1
+
+-- | Swap current screen with previous screen
+swapPrevScreen :: X ()
+swapPrevScreen = swapScreen (-1)
+
+swapScreen :: Int -> X ()
+swapScreen d = do s <- screenBy d
+                  mws <- screenWorkspace s
+                  case mws of
+                    Nothing -> return ()
+                    Just ws -> windows (greedyView ws)
+
+-- | Move focused window to workspace on next screen
+shiftNextScreen :: X ()
+shiftNextScreen = shiftScreenBy 1
+
+-- | Move focused window to workspace on prev screen
+shiftPrevScreen :: X ()
+shiftPrevScreen = shiftScreenBy (-1)
+
+shiftScreenBy :: Int -> X ()
+shiftScreenBy d = do s <- screenBy d
+                     mws <- screenWorkspace s
+                     case mws of
+                         Nothing -> return ()
+                         Just ws -> windows (shift ws)

XMonad/Actions/CycleWindows.hs

@@ -0,0 +1,233 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.CycleWindows
+-- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com>
+-- License      : BSD3-style (see LICENSE)
+--
+-- Maintainer   : Wirt Wolff <wirtwolff@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides bindings to cycle windows up or down on the current workspace
+-- stack while maintaining focus in place.
+--
+-- Bindings are available to:
+--
+-- * Cycle nearby or nth windows into the focused frame
+--
+-- * Cycle a window halfway around the stack
+--
+-- * Cycle windows through the focused position.
+--
+-- * Cycle unfocused windows.
+--
+-- These bindings are especially useful with layouts that hide some of
+-- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or
+-- when using "XMonad.Layout.LimitWindows" to only show three or four
+-- panes. See also "XMonad.Actions.RotSlaves" for related actions.
+-----------------------------------------------------------------------------
+module XMonad.Actions.CycleWindows (
+        -- * Usage
+        -- $usage
+
+        -- * Cycling nearby or nth window into current frame
+        -- $cycle
+        cycleRecentWindows,
+        cycleStacks',
+        -- * Cycling half the stack to get rid of a boring window
+        -- $opposite
+        rotOpposite', rotOpposite,
+        -- * Cycling windows through the current frame
+        -- $focused
+        rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus',
+        -- * Cycling windows through other frames
+        -- $unfocused
+        rotUnfocused', rotUnfocusedUp, rotUnfocusedDown,
+        -- * Updating the mouse pointer
+        -- $pointer
+
+        -- * Generic list rotations
+        -- $generic
+        rotUp, rotDown
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Actions.RotSlaves
+
+import Control.Arrow (second)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleWindows
+-- >    -- config
+-- >    -- other key bindings with x here your config
+-- >
+-- >              -- make sure mod matches keysym
+-- >  , ((mod4Mask,  xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w)
+-- >  , ((modm, xK_z), rotOpposite)
+-- >  , ((modm                , xK_i), rotUnfocusedUp)
+-- >  , ((modm                , xK_u), rotUnfocusedDown)
+-- >  , ((modm .|. controlMask, xK_i), rotFocusedUp)
+-- >  , ((modm .|. controlMask, xK_u), rotFocusedDown)
+--
+-- Also, if you use focus follows mouse, you will want to read the section
+-- on updating the mouse pointer below.  For detailed instructions on
+-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
+{- $pointer
+With FocusFollowsMouse == True, the focus is updated after binding
+actions, possibly focusing a window you didn't intend to focus. Most
+people using TwoPane probably already have a logHook causing the mouse
+to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp")
+
+If you want this built into the key binding instead, use the appropriate
+action from one of those modules to also have your bindings move the pointer
+to the point of your choice on the current window:
+
+> import XMonad.Actions.UpdatePointer -- or Actions.Warp
+
+and either
+
+> -- modify the window rotation bindings
+> , ((modm .|. controlMask, xK_i   ), rotFocusedUp
+>                                            >> updatePointer (Relative 1 1))
+> , ((modm .|. controlMask, xK_u   ), rotFocusedDown
+>                                            >> updatePointer (Relative 1 1))
+>
+>    -- or add to xmonad's logHook
+>    , logHook = dynamicLogWithPP xmobarPP
+>                    >> updatePointer Nearest -- or your preference
+
+-}
+
+-- $cycle
+-- Cycle windows into focus from below or above the focused pane by pressing
+-- a key while one or more modifier keys is held down. The window order isn't
+-- changed until a modifier is released, leaving the previously focused window
+-- just below the new one, (or above if the window just above is chosen.) For
+-- best results use the same modifier + key combination as the one used to invoke
+-- the \"bring from below\" action.  Also, once cycling, pressing a number key n
+-- will focus the nth window, with 0 being the one originally focused.
+cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                               --   As soon as one of them is released, the final switch is made.
+                    -> KeySym  -- ^ Key used to shift windows from below the current choice into the current frame.
+                    -> KeySym  -- ^ Key used to shift windows from above the current choice into the current frame.
+                               --   If it's the same as the first key, it is effectively ignored.
+                    -> X ()
+cycleRecentWindows = cycleStacks' stacks where
+    stacks s = map (shiftToFocus' `flip` s) (wins s)
+    wins (W.Stack t l r) = t : r ++ reverse l
+
+
+-- | Cycle through a /finite/ list of window stacks with repeated presses
+--   of a key while a modifier key is held down. For best results use the same
+--   mod key + key combination as the one used to invoke the \"bring from below\"
+--   action. You could use cycleStacks' with a different stack permutations
+--   function to, for example, cycle from one below to one above to two below,
+--   etc. instead of in order. You are responsible for having it generate a
+--   finite list, though, or xmonad may hang seeking its length.
+cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack.
+                                    -> [KeySym]  -- ^ A list of modifier keys used to invoke 'cycleStacks''.
+                                                 --   As soon as any is released, we're no longer cycling on the [Stack Window]
+                                    -> KeySym    -- ^ Key used to select a \"next\" stack.
+                                    -> KeySym    -- ^ Key used to select a \"previous\" stack.
+                                    -> X ()
+cycleStacks' filteredPerms mods keyNext keyPrev = do
+    XConf {theRoot = root, display = d} <- ask
+    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset
+
+    let evt = allocaXEvent $
+                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p
+                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                           s <- keycodeToKeysym d c 0
+                           return (t, s)
+        choose n (t, s)
+              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)
+              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)
+              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)
+              | t == keyRelease && s `elem` mods = return ()
+              | otherwise                        = doStack n >> io evt >>= choose n
+        doStack n = windows . W.modify' . const $ stacks `cycref` n
+
+    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+    io evt >>= choose 1
+    io $ ungrabKeyboard d currentTime
+  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite
+        numKeyToN = subtract 48 . read . show
+
+-- | Given a stack element and a stack, shift or insert the element (window)
+--   at the currently focused position.
+shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a
+shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs'
+  where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s
+
+
+-- $opposite
+-- Shifts the focused window as far as possible from the current focus,
+-- i.e. halfway around the stack. Windows above the focus up to the \"opposite\"
+-- position remain in place, while those above the insertion shift toward
+-- the current focus. This is useful for people who use lots of windows in Full,
+-- TwoPane, etc., to get rid of boring windows while cycling and swapping
+-- near the focus.
+rotOpposite :: X()
+rotOpposite = windows $ W.modify' rotOpposite'
+
+-- | The opposite rotation on a Stack.
+rotOpposite' :: W.Stack a -> W.Stack a
+rotOpposite' (W.Stack t l r) = W.Stack t' l' r'
+  where rrvl = r ++ reverse l
+        part = (length rrvl + 1) `div` 2
+        (l',t':r') =  second reverse . splitAt (length l) $
+                                reverse (take part rrvl ++ t : drop part rrvl)
+
+
+-- $focused
+-- Most people will want the @rotAllUp@ or @rotAllDown@ actions from
+-- "XMonad.Actions.RotSlaves" to cycle all windows in the stack.
+--
+-- The following actions keep the \"next\" window stable, which is
+-- mostly useful in two window layouts, or when you have a log viewer or
+-- buffer window you want to keep next to the cycled window.
+
+-- | Rotate windows through the focused frame, excluding the \"next\" window.
+-- With, e.g. TwoPane, this allows cycling windows through either the
+-- master or slave pane, without changing the other frame. When the master
+-- is focused, the window below is skipped, when a non-master window is
+-- focused, the master is skipped.
+rotFocusedUp :: X ()
+rotFocusedUp = windows . W.modify' $ rotFocused' rotUp
+rotFocusedDown :: X ()
+rotFocusedDown = windows . W.modify' $ rotFocused' rotDown
+
+-- | The focused rotation on a stack.
+rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
+rotFocused' _ s@(W.Stack _ [] []) = s
+rotFocused' f   (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
+    where (t':rs') = f (t:rs)
+rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s              -- otherwise
+
+
+-- $unfocused
+-- Rotate windows through the unfocused frames. This is similar to
+-- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current
+-- frame rather than master.
+rotUnfocusedUp :: X ()
+rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp
+rotUnfocusedDown :: X ()
+rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown
+
+-- | The unfocused rotation on a stack.
+rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
+rotUnfocused' _ s@(W.Stack _ [] []) = s
+rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s                 -- Master has focus
+rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise
+    where  (master:revls)  = reverse ls
+           (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
+
+-- $generic
+-- Generic list rotations
+rotUp :: [a] -> [a]
+rotUp   l = tail l ++ [head l]
+rotDown :: [a] -> [a]
+rotDown l = last l : init l

XMonad/Actions/DeManage.hs

@@ -1,16 +1,17 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DeManage
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- This module provides a method to cease management of a window
 -- without unmapping it.  This is especially useful for applications
--- like kicker and gnome-panel.
+-- like kicker and gnome-panel.  See also "XMonad.Hooks.ManageDocks" for
+-- more a more automated solution.
 --
 -- To make a panel display correctly with xmonad:
 --
@@ -43,7 +44,7 @@ import XMonad
 --
 -- And add a keybinding, such as:
 --
--- > , ((modMask x,               xK_d     ), withFocused demanage)
+-- > , ((modm,               xK_d     ), withFocused demanage)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".

XMonad/Actions/DwmPromote.hs

@@ -5,7 +5,7 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  arcatan@kapsi.fi
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- Dwm-like swap function for xmonad.
@@ -33,7 +33,7 @@ import XMonad.StackSet
 --
 -- then add a keybinding or substitute 'dwmpromote' in place of promote:
 --
--- >   , ((modMask x,               xK_Return), dwmpromote)
+-- >   , ((modm,               xK_Return), dwmpromote)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".

XMonad/Actions/DynamicWorkspaces.hs

@@ -4,7 +4,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,17 +17,17 @@ module XMonad.Actions.DynamicWorkspaces (
                                          -- * Usage
                                          -- $usage
                                          addWorkspace, removeWorkspace,
+                                         addHiddenWorkspace,
                                          withWorkspace,
                                          selectWorkspace, renameWorkspace,
                                          toNthWorkspace, withNthWorkspace
                                        ) where
 
-import Data.List ( sort )
-
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
 import XMonad.Prompt.Workspace
 import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -36,18 +36,18 @@ import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
 --
 -- Then add keybindings like the following:
 --
--- >   , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)
--- >   , ((modMask x .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)
--- >   , ((modMask x, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))
--- >   , ((modMask x .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))
--- >   , ((modMask x .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
+-- >   , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace)
+-- >   , ((modm .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)
+-- >   , ((modm, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))
+-- >   , ((modm .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))
+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
 --
 -- > -- mod-[1..9]       %! Switch to workspace N
 -- > -- mod-shift-[1..9] %! Move client to workspace N
 -- >    ++
--- >    zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
+-- >    zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
 -- >    ++
--- >    zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
+-- >    zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -63,7 +63,8 @@ mkCompl l s = return $ filter (\x -> take (length s) x == s) l
 
 withWorkspace :: XPConfig -> (String -> X ()) -> X ()
 withWorkspace c job = do ws <- gets (workspaces . windowset)
-                         let ts = sort $ map tag ws
+                         sort <- getSortByIndex
+                         let ts = map tag $ sort ws
                              job' t | t `elem` ts = job t
                                     | otherwise = addHiddenWorkspace t >> job t
                          mkXPrompt (Wor "") c (mkCompl ts) job'
@@ -76,13 +77,15 @@ renameWorkspace conf = workspacePrompt conf $ \w ->
                                        in sets $ removeWorkspace' w s
 
 toNthWorkspace :: (String -> X ()) -> Int -> X ()
-toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
+toNthWorkspace job wnum = do sort <- getSortByIndex
+                             ws <- gets (map tag . sort . workspaces . windowset)
                              case drop wnum ws of
                                (w:_) -> job w
                                [] -> return ()
 
 withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
-withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
+withNthWorkspace job wnum = do sort <- getSortByIndex
+                               ws <- gets (map tag . sort . workspaces . windowset)
                                case drop wnum ws of
                                  (w:_) -> windows $ job w
                                  [] -> return ()
@@ -98,6 +101,8 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
 addWorkspace :: String -> X ()
 addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
 
+
+-- | Add a new hidden workspace with the given name.
 addHiddenWorkspace :: String -> X ()
 addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
                                windows (addHiddenWorkspace' newtag l)

XMonad/Actions/FindEmptyWorkspace.hs

@@ -5,7 +5,7 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  arcatan@kapsi.fi
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- Find an empty workspace.
@@ -32,8 +32,8 @@ import XMonad.StackSet
 --
 -- and add the desired keybindings, for example:
 --
---  >   , ((modMask x,                xK_m    ), viewEmptyWorkspace)
---  >   , ((modMask x .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
+--  >   , ((modm,                xK_m    ), viewEmptyWorkspace)
+--  >   , ((modm .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
 --
 -- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@
 -- will tag the current window to an empty workspace and view it.

XMonad/Actions/FlexibleManipulate.hs

@@ -7,7 +7,7 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  <mgsloan@gmail.com>
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- Move and resize floating windows without warping the mouse.
@@ -17,9 +17,9 @@
 -- Based on the FlexibleResize code by Lukas Mai (mauke).
 
 module XMonad.Actions.FlexibleManipulate (
-	-- * Usage
-	-- $usage
-	mouseWindow, discrete, linear, resize, position
+        -- * Usage
+        -- $usage
+        mouseWindow, discrete, linear, resize, position
 ) where
 
 import XMonad
@@ -31,7 +31,7 @@ import XMonad
 --
 -- Now set up the desired mouse binding, for example:
 --
--- >     , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
+-- >     , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
 --
 -- * Flex.'linear' indicates that positions between the edges and the
 --   middle indicate a combination scale\/position.
@@ -92,7 +92,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
             npos = wpos + offset * atl
             nbr = (wpos + wsize) + offset * abr
             ntl = minP (nbr - (32, 32)) npos    --minimum size
-            nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)
+            nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
         moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
         return ())
         (float w)

XMonad/Actions/FlexibleResize.hs

@@ -13,9 +13,10 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.FlexibleResize (
-	-- * Usage
-	-- $usage
-	XMonad.Actions.FlexibleResize.mouseResizeWindow
+        -- * Usage
+        -- $usage
+        XMonad.Actions.FlexibleResize.mouseResizeWindow,
+        XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow
 ) where
 
 import XMonad
@@ -28,40 +29,53 @@ import Foreign.C.Types
 --
 -- Then add an appropriate mouse binding:
 --
--- >     , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w))
+-- >     , ((modm, button3), (\w -> focus w >> Flex.mouseResizeWindow w))
 --
 -- For detailed instructions on editing your mouse bindings, see
 -- "XMonad.Doc.Extending#Editing_mouse_bindings".
 
 -- | Resize a floating window from whichever corner the mouse is
 --   closest to.
-mouseResizeWindow :: Window -> X ()
-mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
+mouseResizeWindow
+  :: Window -- ^ The window to resize.
+  -> X ()
+mouseResizeWindow = mouseResizeEdgeWindow 0
+
+
+-- | Resize a floating window from whichever corner or edge the mouse is
+--   closest to.
+mouseResizeEdgeWindow
+  :: Rational -- ^ The size of the area where only one edge is resized.
+  -> Window   -- ^ The window to resize.
+  -> X ()
+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w
     wa <- io $ getWindowAttributes d w
     sh <- io $ getWMNormalHints d w
     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
     let
-        [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
-        west  = firstHalf ix width
-        north = firstHalf iy height
+        [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
+        west  = findPos ix width
+        north = findPos iy height
         (cx, fx, gx) = mkSel west  width  pos_x
         (cy, fy, gy) = mkSel north height pos_y
     io $ warpPointer d none w 0 0 0 0 cx cy
-    mouseDrag (\ex ey -> do
-                 wa' <- io $ getWindowAttributes d w
-                 let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y]
-                 io $ moveResizeWindow d w (fx px (fromIntegral ex))
-                                           (fy py (fromIntegral ey))
-                            `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
+    mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)
+                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh)
               (float w)
     where
-    firstHalf :: CInt -> Position -> Bool
-    firstHalf a b = fromIntegral a * 2 <= b
-    cfst = curry fst
-    csnd = curry snd
-    mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position)
-    mkSel b k p =
-        if b
-            then (0, csnd, ((k + p) -) . fromIntegral)
-            else (k, cfst, subtract p  . fromIntegral)
+    findPos :: CInt -> Position -> Maybe Bool
+    findPos m s = if p < 0.5 - edge/2
+                  then Just True
+                  else if p < 0.5 + edge/2
+                       then Nothing
+                       else Just False
+                  where p = fi m / fi s
+    mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
+    mkSel b k p = case b of
+                      Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
+                      Nothing ->    (k `div` 2, const p, const $ fi k)
+                      Just False -> (k, const p, subtract (fi p) . fi)
+
+fi :: (Num b, Integral a) => a -> b
+fi = fromIntegral

XMonad/Actions/FloatKeys.hs

@@ -5,7 +5,7 @@
 -- License      : BSD
 --
 -- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
--- Stability    : unstable
+-- Stability    : stable
 -- Portability  : unportable
 --
 -- Move and resize floating windows.
@@ -28,11 +28,11 @@ import XMonad
 --
 -- Then add appropriate key bindings, for example:
 --
--- >  , ((modMask x,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
--- >  , ((modMask x,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
--- >  , ((modMask x .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
--- >  , ((modMask x .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
--- >  , ((modMask x,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
+-- >  , ((modm,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
+-- >  , ((modm,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
+-- >  , ((modm .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
+-- >  , ((modm .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
+-- >  , ((modm,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -94,7 +94,7 @@ keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
 keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
 keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
     where
-        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
         nx :: Rational
         nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
         ny :: Rational
@@ -103,7 +103,7 @@ keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (n
 keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
 keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
     where
-        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
         nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
         ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
 

XMonad/Actions/FloatSnap.hs

@@ -0,0 +1,328 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.FloatSnap
+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Move and resize floating windows using other windows and the edge of the
+-- screen as guidelines.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FloatSnap (
+                -- * Usage
+                -- $usage
+                Direction2D(..),
+                snapMove,
+                snapGrow,
+                snapShrink,
+                snapMagicMove,
+                snapMagicResize,
+                snapMagicMouseResize) where
+
+import XMonad
+import Control.Applicative((<$>))
+import Data.List (sort)
+import Data.Maybe (listToMaybe,fromJust,isNothing)
+import qualified XMonad.StackSet as W
+
+import XMonad.Hooks.ManageDocks (calcGap)
+import XMonad.Util.Types (Direction2D(..))
+
+import qualified Data.Set as S
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.FloatSnap
+--
+-- Then add appropriate key bindings, for example:
+--
+-- >        , ((modm,               xK_Left),  withFocused $ snapMove L Nothing)
+-- >        , ((modm,               xK_Right), withFocused $ snapMove R Nothing)
+-- >        , ((modm,               xK_Up),    withFocused $ snapMove U Nothing)
+-- >        , ((modm,               xK_Down),  withFocused $ snapMove D Nothing)
+-- >        , ((modm .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
+-- >        , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
+-- >        , ((modm .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
+-- >        , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- And possibly add an appropriate mouse binding, for example:
+--
+-- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
+-- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
+-- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+--
+-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
+-- Note that the order in which the commands are applied in the mouse bindings are important.
+--
+-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
+-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).
+--
+-- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance.
+--
+-- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which
+-- windows it should collide with.
+
+-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the
+--   mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge
+--   will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or
+--   "XMonad.Actions.FlexibleManipulate".
+snapMagicMouseResize
+    :: Rational  -- ^ How big the middle snap area of each axis should be.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window    -- ^ The window to move and resize.
+    -> X ()
+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    wa <- io $ getWindowAttributes d w
+    (_, _, _, px, py, _, _, _) <- io $ queryPointer d w
+    let x = (fromIntegral px - wx wa)/(ww wa)
+        y = (fromIntegral py - wy wa)/(wh wa)
+        ml = if x <= (0.5 - middle/2) then [L] else []
+        mr = if x >  (0.5 + middle/2) then [R] else []
+        mu = if y <= (0.5 - middle/2) then [U] else []
+        md = if y >  (0.5 + middle/2) then [D] else []
+        mdir = ml++mr++mu++md
+        dir = if mdir == []
+              then [L,R,U,D]
+              else mdir
+    snapMagicResize dir collidedist snapdist w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen.
+snapMagicResize
+    :: [Direction2D] -- ^ The edges to snap.
+    -> Maybe Int   -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window      -- ^ The window to move and resize.
+    -> X ()
+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+
+    (xbegin,xend) <- handleAxis True d wa
+    (ybegin,yend) <- handleAxis False d wa
+
+    let xbegin' = if L `elem` dir then xbegin else (wx wa)
+        xend'   = if R `elem` dir then xend   else (wx wa + ww wa)
+        ybegin' = if U `elem` dir then ybegin else (wy wa)
+        yend'   = if D `elem` dir then yend   else (wy wa + wh wa)
+
+    io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
+    io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
+    float w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+        handleAxis horiz d wa = do
+            ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
+            let begin = if bs
+                        then wpos wa
+                        else case (mbl,mbr) of
+                            (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
+                            (Just bl,Nothing) -> bl
+                            (Nothing,Just br) -> br
+                            (Nothing,Nothing) -> wpos wa
+                end = if fs
+                      then wpos wa + wdim wa
+                      else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
+                          (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
+                          (Just fl,Nothing) -> fl
+                          (Nothing,Just fr) -> fr
+                          (Nothing,Nothing) -> wpos wa + wdim wa
+                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
+                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
+            return (begin',end')
+            where
+                (wpos, wdim, _, _) = constructors horiz
+
+
+-- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen.
+snapMagicMove
+    :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window    -- ^ The window to move.
+    -> X ()
+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+
+    nx <- handleAxis True d wa
+    ny <- handleAxis False d wa
+
+    io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
+    float w
+    where
+        handleAxis horiz d wa = do
+            ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
+            return $ if bs || fs
+                     then wpos wa
+                     else let b = case (mbl,mbr) of
+                                    (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
+                                    (Just bl,Nothing) -> bl
+                                    (Nothing,Just br) -> br
+                                    (Nothing,Nothing) -> wpos wa
+                              f = case (mfl,mfr) of
+                                    (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
+                                    (Just fl,Nothing) -> fl
+                                    (Nothing,Just fr) -> fr
+                                    (Nothing,Nothing) -> wpos wa
+                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
+                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
+            where
+                (wpos, wdim, _, _) = constructors horiz
+
+-- | Move a window in the specified direction until it snaps against another window or the edge of the screen.
+snapMove
+    :: Direction2D -- ^ What direction to move the window in.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to move.
+    -> X ()
+snapMove L = doSnapMove True True
+snapMove R = doSnapMove True False
+snapMove U = doSnapMove False True
+snapMove D = doSnapMove False False
+
+doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
+
+    let (mb,mf) = if rev then (bl,fl)
+                         else (br,fr)
+
+        newpos = fromIntegral $ case (mb,mf) of
+                                    (Just b,Nothing) -> b
+                                    (Nothing,Just f) -> f - wdim wa
+                                    (Just b,Just f) -> if rev /= (b < f - wdim wa)
+                                                       then b
+                                                       else f - wdim wa
+                                    _ -> wpos wa
+
+    if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa)
+             else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos
+    float w
+
+    where
+        (wpos, wdim, _, _) = constructors horiz
+
+-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen.
+snapGrow
+    :: Direction2D -- ^ What edge of the window to grow.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to grow.
+    -> X ()
+snapGrow = snapResize True
+
+-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen.
+snapShrink
+    :: Direction2D -- ^ What edge of the window to shrink.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to shrink.
+    -> X ()
+snapShrink = snapResize False
+
+snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    mr <- case dir of
+              L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa)
+                                   _ -> Nothing
+              R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, wy wa, v - wx wa, wh wa)
+                                   _ -> Nothing
+              U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v)
+                                   _ -> Nothing
+              D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, wy wa, ww wa, v - wy wa)
+                                   _ -> Nothing
+
+    case mr of
+        Nothing -> return ()
+        Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
+                                                      io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
+                                              else return ()
+    float w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+
+getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool))
+getSnap horiz collidedist d w = do
+    wa <- io $ getWindowAttributes d w
+    screen <- W.current <$> gets windowset
+    let sr = screenRect $ W.screenDetail screen
+        wl = W.integrate' . W.stack $ W.workspace screen
+    gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
+    wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
+
+    return ( neighbours (back wa sr gr wla) (wpos wa)
+           , neighbours (front wa sr gr wla) (wpos wa + wdim wa)
+           )
+
+    where
+        wborder = fromIntegral.wa_border_width
+
+        (wpos, wdim, rpos, rdim) = constructors horiz
+        (refwpos, refwdim, _, _) = constructors $ not horiz
+
+        back wa sr gr wla = dropWhile (< rpos sr) $
+                            takeWhile (< rpos sr + rdim sr) $
+                            sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
+                                   foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
+
+        front wa sr gr wla = dropWhile (<= rpos sr) $
+                             takeWhile (<= rpos sr + rdim sr) $
+                             sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa):
+                                    foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla
+
+        neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l
+                         , listToMaybe $ dropWhile (<= v) l
+                         , v `elem` l
+                         )
+
+        collides wa oa = case collidedist of
+                             Nothing -> True
+                             Just dist -> (  refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
+                                          && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
+
+
+constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
+constructors True = ( fromIntegral.wa_x
+                    , fromIntegral.wa_width
+                    , fromIntegral.rect_x
+                    , fromIntegral.rect_width
+                    )
+constructors False = ( fromIntegral.wa_y
+                     , fromIntegral.wa_height
+                     , fromIntegral.rect_y
+                     , fromIntegral.rect_height
+                     )

XMonad/Actions/FocusNth.hs

@@ -5,7 +5,7 @@
 -- License      : BSD
 --
 -- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
--- Stability    : unstable
+-- Stability    : stable
 -- Portability  : unportable
 --
 -- Focus the nth window of the current workspace.
@@ -14,7 +14,7 @@
 module XMonad.Actions.FocusNth (
                  -- * Usage
                  -- $usage
-                 focusNth) where
+                 focusNth,focusNth') where
 
 import XMonad.StackSet
 import XMonad
@@ -27,7 +27,7 @@ import XMonad
 -- Then add appropriate keybindings, for example:
 --
 -- > -- mod4-[1..9] @@ Switch to window N
--- > ++ [((modMask x, k), focusNth i)
+-- > ++ [((modm, k), focusNth i)
 -- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
 --
 -- For detailed instructions on editing your key bindings, see
@@ -38,12 +38,13 @@ focusNth :: Int -> X ()
 focusNth = windows . modify' . focusNth'
 
 focusNth' :: Int -> Stack a -> Stack a
-focusNth' n s@(Stack _ ls rs)	| (n < 0) || (n > length(ls) + length(rs)) = s
-				| otherwise = listToStack n (integrate s)
+focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
+                              | otherwise = listToStack n (integrate s)
 
 listToStack :: Int -> [a] -> Stack a
 listToStack n l = Stack t ls rs
-	where	(t:rs)	= drop n l
-		ls	= reverse (take n l)
+ where
+    (t:rs)    = drop n l
+    ls        = reverse (take n l)
 
 

XMonad/Actions/GridSelect.hs

@@ -0,0 +1,525 @@
+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.GridSelect
+-- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Clemens Fruhwirth <clemens@endorphin.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- GridSelect displays items(e.g. the opened windows) in a 2D grid and lets
+-- the user select from it with the cursor/hjkl keys or the mouse.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.GridSelect (
+    -- * Usage
+    -- $usage
+
+    -- ** Customizing
+    -- *** Using a common GSConfig
+    -- $commonGSConfig
+
+    -- *** Custom keybindings
+    -- $keybindings
+
+    -- * Configuration
+    GSConfig(..),
+    defaultGSConfig,
+    NavigateMap,
+    TwoDPosition,
+    buildDefaultGSConfig,
+
+    -- * Variations on 'gridselect'
+    gridselect,
+    gridselectWindow,
+    withSelectedWindow,
+    bringSelected,
+    goToSelected,
+    spawnSelected,
+    runSelectedAction,
+
+    -- * Colorizers
+    HasColorizer(defaultColorizer),
+    fromClassName,
+    stringColorizer,
+    colorRangeFromClassName
+
+    -- * Screenshots
+    -- $screenshots
+    ) where
+import Data.Maybe
+import Data.Bits
+import Control.Applicative
+import Control.Monad.State
+import Control.Arrow
+import Data.List as L
+import qualified Data.Map as M
+import XMonad hiding (liftX)
+import XMonad.Util.Font
+import XMonad.Prompt (mkUnmanagedWindow)
+import XMonad.StackSet as W
+import XMonad.Layout.Decoration
+import XMonad.Util.NamedWindows
+import XMonad.Actions.WindowBringer (bringWindow)
+import Text.Printf
+import System.Random (mkStdGen, genRange, next)
+import Data.Word (Word8)
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.GridSelect
+--
+-- Then add a keybinding, e.g.
+--
+-- >    , ((modm, xK_g), goToSelected defaultGSConfig)
+--
+-- This module also supports displaying arbitrary information in a grid and letting
+-- the user select from it. E.g. to spawn an application from a given list, you
+-- can use the following:
+--
+-- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
+
+-- $commonGSConfig
+--
+-- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so:
+--
+-- > -- the top of your config
+-- > {-# LANGUAGE NoMonomorphismRestriction #-}
+-- > import XMonad
+-- > ...
+-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellWidth = 100 }
+--
+-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
+-- in order to specify a custom colorizer is @gsconfig2@ (found in
+-- "XMonad.Actions.GridSelect#Colorizers"):
+--
+-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellWidth = 100 }
+--
+-- > -- | A green monochrome colorizer based on window class
+-- > greenColorizer = colorRangeFromClassName
+-- >                      black            -- lowest inactive bg
+-- >                      (0x70,0xFF,0x70) -- highest inactive bg
+-- >                      black            -- active bg
+-- >                      white            -- inactive fg
+-- >                      white            -- active fg
+-- >   where black = minBound
+-- >         white = maxBound
+--
+-- Then you can bind to:
+--
+-- >     ,((modm, xK_g), goToSelected  $ gsconfig2 myWinColorizer)
+-- >     ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)
+
+-- $keybindings
+--
+-- Adding more keybindings for gridselect to listen to is similar:
+--
+-- At the top of your config:
+--
+-- > {-# LANGAUGE NoMonomorphismRestriction #-}
+-- > import XMonad
+-- > import qualified Data.Map as M
+--
+-- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
+--
+-- > gsconfig3 = defaultGSConfig
+-- >    { gs_cellheight = 30
+-- >    , gs_cellwidth = 100
+-- >    , gs_navigate = M.unions
+-- >            [reset
+-- >            ,nethackKeys
+-- >            ,gs_navigate                               -- get the default navigation bindings
+-- >                $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable
+-- >            ]
+-- >    }
+-- >   where addPair (a,b) (x,y) = (a+x,b+y)
+-- >         nethackKeys = M.map addPair $ M.fromList
+-- >                               [((0,xK_y),(-1,-1))
+-- >                               ,((0,xK_i),(1,-1))
+-- >                               ,((0,xK_n),(-1,1))
+-- >                               ,((0,xK_m),(1,1))
+-- >                               ]
+-- >         -- jump back to the center with the spacebar, regardless of the current position.
+-- >         reset = M.singleton (0,xK_space) (const (0,0))
+
+-- $screenshots
+--
+-- Selecting a workspace:
+--
+-- <<http://haskell.org/sitewiki/images/a/a9/Xmonad-gridselect-workspace.png>>
+--
+-- Selecting a window by title:
+--
+-- <<http://haskell.org/sitewiki/images/3/35/Xmonad-gridselect-window-aavogt.png>>
+
+data GSConfig a = GSConfig {
+      gs_cellheight :: Integer,
+      gs_cellwidth :: Integer,
+      gs_cellpadding :: Integer,
+      gs_colorizer :: a -> Bool -> X (String, String),
+      gs_font :: String,
+      gs_navigate :: NavigateMap,
+      gs_originFractX :: Double,
+      gs_originFractY :: Double
+}
+
+-- | That is 'fromClassName' if you are selecting a 'Window', or
+-- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance
+-- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor'
+-- colors.
+class HasColorizer a where
+    defaultColorizer :: a -> Bool -> X (String, String)
+
+instance HasColorizer Window where
+    defaultColorizer = fromClassName
+
+instance HasColorizer String where
+    defaultColorizer = stringColorizer
+
+instance HasColorizer a where
+    defaultColorizer _ isFg =
+        let getColor = if isFg then focusedBorderColor else normalBorderColor
+        in asks $ flip (,) "black" . getColor . config
+
+-- | A basic configuration for 'gridselect', with the colorizer chosen based on the type.
+--
+-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
+-- instead, to avoid ambiguous type variables.
+defaultGSConfig :: HasColorizer a => GSConfig a
+defaultGSConfig = buildDefaultGSConfig defaultColorizer
+
+type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)
+
+type TwoDPosition = (Integer, Integer)
+
+type TwoDElementMap a = [(TwoDPosition,(String,a))]
+
+data TwoDState a = TwoDState { td_curpos :: TwoDPosition
+                             , td_elementmap :: TwoDElementMap a
+                             , td_gsconfig :: GSConfig a
+                             , td_font :: XMonadFont
+                             , td_paneX :: Integer
+                             , td_paneY :: Integer
+                             , td_drawingWin :: Window
+                             }
+
+newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
+    deriving (Monad,Functor,MonadState (TwoDState a))
+
+instance Applicative (TwoD a) where
+    (<*>) = ap
+    pure = return
+
+liftX ::  X a1 -> TwoD a a1
+liftX = TwoD . lift
+
+evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
+evalTwoD m s = flip evalStateT s $ unTwoD m
+
+diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
+-- FIXME remove nub
+diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
+        in nub $ ul ++ (map (negate *** id) ul) ++
+           (map (negate *** negate) ul) ++
+           (map (id *** negate) ul)
+
+diamond :: (Enum a, Num a) => [(a, a)]
+diamond = concatMap diamondLayer [0..]
+
+diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
+diamondRestrict x y originX originY =
+  L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
+  map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
+  take 1000 $ diamond
+
+tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)
+tupadd (a,b) (c,d) = (a+c,b+d)
+
+findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
+findInElementMap pos = find ((== pos) . fst)
+
+drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
+drawWinBox win font (fg,bg) ch cw text x y cp =
+  withDisplay $ \dpy -> do
+  gc <- liftIO $ createGC dpy win
+  bordergc <- liftIO $ createGC dpy win
+  liftIO $ do
+    Just fgcolor <- initColor dpy fg
+    Just bgcolor <- initColor dpy bg
+    Just bordercolor <- initColor dpy borderColor
+    setForeground dpy gc fgcolor
+    setBackground dpy gc bgcolor
+    setForeground dpy bordergc bordercolor
+    fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
+    drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
+  stext <- shrinkWhile (shrinkIt shrinkText)
+           (\n -> do size <- liftIO $ textWidthXMF dpy font n
+                     return $ size > (fromInteger (cw-(2*cp))))
+           text
+  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext
+  liftIO $ freeGC dpy gc
+  liftIO $ freeGC dpy bordergc
+
+updateAllElements :: TwoD a ()
+updateAllElements =
+    do
+      TwoDState { td_elementmap = els } <- get
+      updateElements els
+
+updateElements :: TwoDElementMap a -> TwoD a ()
+updateElements elementmap = do
+    TwoDState { td_curpos = curpos,
+                td_drawingWin = win,
+                td_gsconfig = gsconfig,
+                td_font = font,
+                td_paneX = paneX,
+                td_paneY = paneY} <- get
+    let cellwidth = gs_cellwidth gsconfig
+        cellheight = gs_cellheight gsconfig
+        paneX' = div (paneX-cellwidth) 2
+        paneY' = div (paneY-cellheight) 2
+        updateElement (pos@(x,y),(text, element)) = liftX $ do
+            colors <- gs_colorizer gsconfig element (pos == curpos)
+            drawWinBox win font
+                       colors
+                       cellheight
+                       cellwidth
+                       text
+                       (paneX'+x*cellwidth)
+                       (paneY'+y*cellheight)
+                       (gs_cellpadding gsconfig)
+    mapM_ updateElement elementmap
+
+eventLoop :: TwoD a (Maybe a)
+eventLoop = do
+  (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+                             ev <- getEvent e
+                             (ks,s) <- if ev_event_type ev == keyPress
+                                       then lookupString $ asKeyEvent e
+                                       else return (Nothing, "")
+                             return (ks,s,ev)
+  handle (fromMaybe xK_VoidSymbol keysym,string) event
+
+handle ::  (KeySym, t) -> Event -> TwoD a (Maybe a)
+handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })
+    | t == keyPress && ks == xK_Escape = return Nothing
+    | t == keyPress && ks == xK_Return = do
+       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get
+       return $ fmap (snd . snd) $ findInElementMap pos elmap
+    | t == keyPress = do
+        m' <- liftX (cleanMask m)
+        keymap <- gets (gs_navigate . td_gsconfig)
+        maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap
+  where diffAndRefresh diff = do
+          state <- get
+          let elmap = td_elementmap state
+              oldPos = td_curpos state
+              newPos = diff oldPos
+              newSelectedEl = findInElementMap newPos elmap
+          when (isJust newSelectedEl) $ do
+                                put state { td_curpos =  newPos }
+                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+          eventLoop
+
+handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })
+    | t == buttonRelease = do
+        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,
+                     td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get
+        let gridX = (fi x - (px - cw) `div` 2) `div` cw
+            gridY = (fi y - (py - ch) `div` 2) `div` ch
+        case lookup (gridX,gridY) elmap of
+             Just (_,el) -> return (Just el)
+             Nothing -> eventLoop
+    | otherwise = eventLoop
+
+handle _ (ExposeEvent { }) = updateAllElements >> eventLoop
+
+handle _ _ = eventLoop
+
+-- FIXME probably move that into Utils?
+-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
+hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
+hsv2rgb (h,s,v) =
+    let hi = (div h 60) `mod` 6 :: Integer
+        f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
+        q = v * (1-f)
+        p = v * (1-s)
+        t = v * (1-(1-f)*s)
+    in case hi of
+         0 -> (v,t,p)
+         1 -> (q,v,p)
+         2 -> (p,v,t)
+         3 -> (p,q,v)
+         4 -> (t,p,v)
+         5 -> (v,p,q)
+         _ -> error "The world is ending. x mod a >= a."
+
+-- | Default colorizer for Strings
+stringColorizer :: String -> Bool -> X (String, String)
+stringColorizer s active =
+    let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
+        (r,g,b) = hsv2rgb ((seed 83) `mod` 360,
+                           (fromInteger ((seed 191) `mod` 1000))/2500+0.4,
+                           (fromInteger ((seed 121) `mod` 1000))/2500+0.4)
+    in if active
+         then return ("#faff69", "black")
+         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
+
+-- | Colorize a window depending on it's className.
+fromClassName :: Window -> Bool -> X (String, String)
+fromClassName w active = runQuery className w >>= flip defaultColorizer active
+
+twodigitHex :: Word8 -> String
+twodigitHex a = printf "%02x" a
+
+-- | A colorizer that picks a color inside a range,
+-- and depending on the window's class.
+colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range
+                        -> (Word8, Word8, Word8) -- ^ End of the color range
+                        -> (Word8, Word8, Word8) -- ^ Background of the active window
+                        -> (Word8, Word8, Word8) -- ^ Inactive text color
+                        -> (Word8, Word8, Word8) -- ^ Active text color
+                        -> Window -> Bool -> X (String, String)
+colorRangeFromClassName startC endC activeC inactiveT activeT w active =
+    do classname <- runQuery className w
+       if active
+         then return (rgbToHex activeC, rgbToHex activeT)
+         else return (rgbToHex $ mix startC endC
+                  $ stringToRatio classname, rgbToHex inactiveT)
+    where rgbToHex :: (Word8, Word8, Word8) -> String
+          rgbToHex (r, g, b) = '#':twodigitHex r
+                               ++twodigitHex g++twodigitHex b
+
+-- | Creates a mix of two colors according to a ratio
+-- (1 -> first color, 0 -> second color).
+mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)
+        -> Double -> (Word8, Word8, Word8)
+mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2)
+    where  mix' a b = truncate $ (fi a * r) + (fi b * (1 - r))
+
+-- | Generates a Double from a string, trying to
+-- achieve a random distribution.
+-- We create a random seed from the sum of all characters
+-- in the string, and use it to generate a ratio between 0 and 1
+stringToRatio :: String -> Double
+stringToRatio "" = 0
+stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
+                      range = (\(a, b) -> b - a) $ genRange gen
+                      randomInt = foldr1 combine $ replicate 20 next
+                      combine f1 f2 g = let (_, g') = f1 g in f2 g'
+                  in fi (fst $ randomInt gen) / fi range
+
+-- | Brings up a 2D grid of elements in the center of the screen, and one can
+-- select an element with cursors keys. The selected element is returned.
+gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
+gridselect gsconfig elmap =
+ withDisplay $ \dpy -> do
+    rootw <- asks theRoot
+    s <- gets $ screenRect . W.screenDetail . W.current . windowset
+    win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
+                    (rect_x s) (rect_y s) (rect_width s) (rect_height s)
+    liftIO $ mapWindow dpy win
+    liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
+    status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
+    io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
+    font <- initXMF (gs_font gsconfig)
+    let screenWidth = toInteger $ rect_width s;
+        screenHeight = toInteger $ rect_height s;
+    selectedElement <- if (status == grabSuccess) then do
+                            let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
+                                restrictX = floor $ restriction screenWidth gs_cellwidth
+                                restrictY = floor $ restriction screenHeight gs_cellheight
+                                originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
+                                originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
+                                coords = diamondRestrict restrictX restrictY originPosX originPosY
+                                elmap' = zip coords elmap
+
+                            evalTwoD (updateAllElements >> eventLoop)
+                                (TwoDState (head coords)
+                                            elmap'
+                                            gsconfig
+                                            font
+                                            screenWidth
+                                            screenHeight
+                                            win)
+                      else
+                          return Nothing
+    liftIO $ do
+      unmapWindow dpy win
+      destroyWindow dpy win
+      sync dpy False
+    releaseXMF font
+    return selectedElement
+
+-- | Like `gridSelect' but with the current windows and their titles as elements
+gridselectWindow :: GSConfig Window -> X (Maybe Window)
+gridselectWindow gsconf = windowMap >>= gridselect gsconf
+
+-- | Brings up a 2D grid of windows in the center of the screen, and one can
+-- select a window with cursors keys. The selected window is then passed to
+-- a callback function.
+withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
+withSelectedWindow callback conf = do
+    mbWindow <- gridselectWindow conf
+    case mbWindow of
+        Just w -> callback w
+        Nothing -> return ()
+
+windowMap :: X [(String,Window)]
+windowMap = do
+    ws <- gets windowset
+    wins <- mapM keyValuePair (W.allWindows ws)
+    return wins
+ where keyValuePair w = flip (,) w `fmap` decorateName' w
+
+decorateName' :: Window -> X String
+decorateName' w = do
+  fmap show $ getName w
+
+-- | Builds a default gs config from a colorizer function.
+buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)
+
+defaultGSNav :: NavigateMap
+defaultGSNav = M.map tupadd $ M.fromList
+    [((0,xK_Left) ,(-1,0))
+    ,((0,xK_h)    ,(-1,0))
+    ,((0,xK_Right),(1,0))
+    ,((0,xK_l)    ,(1,0))
+    ,((0,xK_Down) ,(0,1))
+    ,((0,xK_j)    ,(0,1))
+    ,((0,xK_Up)   ,(0,-1))
+    ,((0,xK_k)    ,(0,-1))
+    ]
+
+borderColor :: String
+borderColor = "white"
+
+-- | Brings selected window to the current workspace.
+bringSelected :: GSConfig Window -> X ()
+bringSelected = withSelectedWindow $ \w -> do
+    windows (bringWindow w)
+    XMonad.focus w
+    windows W.shiftMaster
+
+-- | Switches to selected window's workspace and focuses that window.
+goToSelected :: GSConfig Window -> X ()
+goToSelected = withSelectedWindow $ windows . W.focusWindow
+
+-- | Select an application to spawn from a given list
+spawnSelected :: GSConfig String -> [String] -> X ()
+spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn
+
+-- | Select an action and run it in the X monad
+runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
+runSelectedAction conf actions = do
+    selectedActionM <- gridselect conf actions
+    case selectedActionM of
+        Just selectedAction -> selectedAction
+        Nothing -> return ()

XMonad/Actions/MessageFeedback.hs

@@ -0,0 +1,99 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.MessageFeedback
+-- Copyright    : (c) Quentin Moser <quentin.moser@unifr.ch>
+-- License      : BSD3
+--
+-- Maintainer   : None
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge
+-- of whether the message was handled, and utility functions based on
+-- this facility.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.MessageFeedback (
+                                      -- * Usage
+                                      -- $usage
+
+                                        send
+                                      , tryMessage
+                                      , tryMessage_
+                                      , tryInOrder
+                                      , tryInOrder_
+                                      , sm
+                                      , sendSM
+                                      , sendSM_
+                                      ) where
+
+import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
+import XMonad.StackSet ( current, workspace, layout, tag )
+import XMonad.Operations ( updateLayout )
+
+import Control.Monad.State ( gets )
+import Data.Maybe ( isJust )
+import Control.Applicative ((<$>))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.MessageFeedback
+--
+-- You can then use this module's functions wherever an action is expected.
+--
+-- Note that most functions in this module have a return type of @X Bool@
+-- whereas configuration options will expect a @X ()@ action.
+-- For example, the key binding
+--
+-- > -- Shrink the master area of a tiled layout, or move the focused window
+-- > -- to the left in a WindowArranger-based layout
+-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))
+--
+-- is mis-typed. For this reason, this module provides alternatives (ending with
+-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
+-- For example, to correct the previous example:
+--
+-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
+--
+
+
+-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
+-- message was handled by the layout, False otherwise.
+send :: Message a => a -> X Bool
+send = sendSM . sm
+
+-- | Sends the first message, and if it was not handled, sends the second.
+-- Returns True if either message was handled, False otherwise.
+tryMessage :: (Message a, Message b) => a -> b -> X Bool
+tryMessage m1 m2 = do b <- send m1
+                      if b then return True else send m2
+
+tryMessage_ :: (Message a, Message b) => a -> b -> X ()
+tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
+
+-- | Tries sending every message of the list in order until one of them
+-- is handled. Returns True if one of the messages was handled, False otherwise.
+tryInOrder :: [SomeMessage] -> X Bool
+tryInOrder [] = return False
+tryInOrder (m:ms) = do b <- sendSM m
+                       if b then return True else tryInOrder ms
+
+tryInOrder_ :: [SomeMessage] -> X ()
+tryInOrder_ ms = tryInOrder ms >> return ()
+
+
+-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
+sm :: Message a => a -> SomeMessage
+sm = SomeMessage
+
+
+sendSM :: SomeMessage -> X Bool
+sendSM m = do w <- workspace . current <$> gets windowset
+              ml' <- handleMessage (layout w) m `catchX` return Nothing
+              updateLayout (tag w) ml'
+              return $ isJust ml'
+
+
+sendSM_ :: SomeMessage -> X ()
+sendSM_ m = sendSM m >> return ()

XMonad/Actions/MouseGestures.hs

@@ -15,29 +15,31 @@
 module XMonad.Actions.MouseGestures (
     -- * Usage
     -- $usage
-	Direction(..),
-    mouseGesture
+    Direction2D(..),
+    mouseGestureH,
+    mouseGesture,
+    mkCollect
 ) where
 
 import XMonad
+import XMonad.Util.Types (Direction2D(..))
 
 import Data.IORef
 import qualified Data.Map as M
 import Data.Map (Map)
+import Data.Maybe
 import Control.Monad
 
-import System.IO
-
 -- $usage
 --
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonad.Actions.Commands
+-- > import XMonad.Actions.MouseGestures
 -- > import qualified XMonad.StackSet as W
 --
 -- then add an appropriate mouse binding:
 --
--- >     , ((modMask x .|. shiftMask, button3), mouseGesture gestures)
+-- >     , ((modm .|. shiftMask, button3), mouseGesture gestures)
 --
 -- where @gestures@ is a 'Data.Map.Map' from gestures to actions on
 -- windows, for example:
@@ -55,11 +57,6 @@ import System.IO
 -- For detailed instructions on editing your mouse bindings, see
 -- "XMonad.Doc.Extending#Editing_mouse_bindings".
 
--- | The four cardinal screen directions. A \"gesture\" is a sequence of
---   directions.
-data Direction = L | U | R | D
-    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
 type Pos = (Position, Position)
 
 delta :: Pos -> Pos -> Position
@@ -67,10 +64,10 @@ delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
     where
     d a b = abs (a - b)
 
-dir :: Pos -> Pos -> Direction
+dir :: Pos -> Pos -> Direction2D
 dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
     where
-    trans :: Double -> Direction
+    trans :: Double -> Direction2D
     trans x
         | rg (-3/4) (-1/4) x = D
         | rg (-1/4)  (1/4) x = R
@@ -78,48 +75,63 @@ dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromInt
         | otherwise          = L
     rg a z x = a <= x && x < z
 
-debugging :: Int
-debugging = 0
-
-collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X ()
-collect st nx ny = do
+gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
+gauge hook op st nx ny = do
     let np = (nx, ny)
-    stx@(op, ds) <- io $ readIORef st
-    when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "")
-    case ds of
-        []
-            | insignificant np op -> return ()
-            | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)])
-        (d, zp, ap_) : ds'
-            | insignificant np zp -> return ()
-            | otherwise -> do
-                let
-                    d' = dir zp np
-                    ds''
-                        | d == d'   = (d, np, ap_) : ds'
-                        | otherwise = (d', np, zp) : ds
-                io $ writeIORef st (op, ds'')
+    stx <- io $ readIORef st
+    let
+        (~(Just od), pivot) = case stx of
+            Nothing -> (Nothing, op)
+            Just (d, zp) -> (Just d, zp)
+        cont = do
+            guard $ significant np pivot
+            return $ do
+                let d' = dir pivot np
+                when (isNothing stx || od /= d') $ hook d'
+                io $ writeIORef st (Just (d', np))
+    fromMaybe (return ()) cont
     where
-    insignificant a b = delta a b < 10
+    significant a b = delta a b >= 10
 
-extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction]
-extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs
-
--- | Given a 'Data.Map.Map' from lists of directions to actions with
---   windows, figure out which one the user is performing, and return
---   the corresponding action.
-mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()
-mouseGesture tbl win = withDisplay $ \dpy -> do
+-- | @'mouseGestureH' moveHook endHook@ is a mouse button
+-- event handler. It collects mouse movements, calling @moveHook@ for each
+-- update; when the button is released, it calls @endHook@.
+mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
+mouseGestureH moveHook endHook = do
+    dpy <- asks display
     root <- asks theRoot
-    let win' = if win == none then root else win
-    acc <- io $ do
-        qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win'
-        when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp
-        when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none"
-        newIORef ((fromIntegral ix, fromIntegral iy), [])
-    mouseDrag (collect acc) $ do
-        when (debugging > 0) $ io $ putStrLn $ show ""
-        gest <- io $ liftM extract $ readIORef acc
+    (pos, acc) <- io $ do
+        (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root
+        r <- newIORef Nothing
+        return ((fromIntegral ix, fromIntegral iy), r)
+    mouseDrag (gauge moveHook pos acc) endHook
+
+-- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to
+-- look up the mouse gesture, then executes the corresponding action (if any).
+mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
+mouseGesture tbl win = do
+    (mov, end) <- mkCollect
+    mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
         case M.lookup gest tbl of
             Nothing -> return ()
-            Just f -> f win'
+            Just f -> f win
+
+-- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two
+-- callback functions for passing to 'mouseGestureH'. The move hook will
+-- collect mouse movements (and return the current gesture as a list); the end
+-- hook will return a list of the completed gesture, which you can access with
+-- 'Control.Monad.>>='.
+mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
+mkCollect = liftIO $ do
+    acc <- newIORef []
+    let
+        mov d = liftIO $ do
+            ds <- readIORef acc
+            let ds' = d : ds
+            writeIORef acc ds'
+            return $ reverse ds'
+        end = liftIO $ do
+            ds <- readIORef acc
+            writeIORef acc []
+            return $ reverse ds
+    return (mov, end)

XMonad/Actions/MouseResize.hs

@@ -0,0 +1,133 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MouseResize
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier to resize windows with the mouse by grabbing the
+-- window's lower right corner.
+--
+-- This module must be used together with "XMonad.Layout.WindowArranger".
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.MouseResize
+    ( -- * Usage:
+      -- $usage
+      mouseResize
+    , MouseResize (..)
+    ) where
+
+import Control.Monad
+import Data.Maybe
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.LayoutModifier
+
+import XMonad.Layout.WindowArranger
+import XMonad.Util.XUtils
+
+-- $usage
+-- Usually this module is used to create layouts, but you can also use
+-- it to resize windows in any layout, together with the
+-- "XMonad.Layout.WindowArranger". For usage example see
+-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
+--
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.MouseResize
+-- > import XMonad.Layout.WindowArranger
+--
+-- Then edit your @layoutHook@ by modifying a given layout:
+--
+-- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig
+--
+-- and then:
+--
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+mouseResize :: l a -> ModifiedLayout MouseResize l a
+mouseResize = ModifiedLayout (MR [])
+
+data MouseResize a = MR [((a,Rectangle),Maybe a)]
+instance Show (MouseResize a) where show        _ = ""
+instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
+
+instance LayoutModifier MouseResize Window where
+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
+    redoLayout (MR st) _ (Just s) wrs
+        | [] <- st  = initState    >>= \nst -> return (wrs, Just $ MR nst)
+        | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
+        where
+          wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs
+          initState    = mapM createInputWindow wrs'
+          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
+
+          inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
+
+          wrs_to_state rs ((w,r):xs)
+              | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs
+              | otherwise         = ((w,r),Nothing) : wrs_to_state (r:   rs) xs
+              where ir = inputRectangle r
+          wrs_to_state _ [] = []
+
+    handleMess (MR s) m
+        | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing
+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ MR [])
+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR [])
+        where releaseResources = mapM_ (deleteInputWin . snd) s
+    handleMess _ _ = return Nothing
+
+handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()
+handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
+    | et == buttonPress
+    , Just (w,Rectangle wx wy _ _) <- getWin ew st = do
+                                        focus w
+                                        mouseDrag (\x y -> do
+                                                     let rect = Rectangle wx wy
+                                                                (max 1 . fi $ x - wx)
+                                                                (max 1 . fi $ y - wy)
+                                                     sendMessage (SetGeometry rect)) (return ())
+
+      where
+        getWin w (((win,r),tw):xs)
+            | Just w' <- tw
+            , w == w'   = Just (win,r)
+            | otherwise = getWin w xs
+        getWin _ []     = Nothing
+handleResize _ _ = return ()
+
+createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
+createInputWindow ((w,r),mr) = do
+  case mr of
+    Just tr  -> withDisplay $ \d -> do
+                  tw <- mkInputWindow d tr
+                  io $ selectInput d tw (exposureMask .|. buttonPressMask)
+                  showWindow tw
+                  return ((w,r), Just tw)
+    Nothing ->    return ((w,r), Nothing)
+
+deleteInputWin :: Maybe Window -> X ()
+deleteInputWin = maybe (return ()) deleteWindow
+
+mkInputWindow :: Display -> Rectangle -> X Window
+mkInputWindow d (Rectangle x y w h) = do
+  rw <- asks theRoot
+  let screen   = defaultScreenOfDisplay d
+      visual   = defaultVisualOfScreen screen
+      attrmask = cWOverrideRedirect
+  io $ allocaSetWindowAttributes $
+         \attributes -> do
+           set_override_redirect attributes True
+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes

XMonad/Actions/NoBorders.hs

@@ -0,0 +1,33 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.NoBorders
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Lukas Mai <l.mai@web.de>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- This module provides helper functions for dealing with window borders.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.NoBorders (
+    toggleBorder
+) where
+
+import XMonad
+
+-- | Toggle the border of the currently focused window. To use it, add a
+-- keybinding like so:
+--
+-- > , ((modm,  xK_g ),   withFocused toggleBorder)
+--
+toggleBorder :: Window -> X ()
+toggleBorder w = do
+    bw <- asks (borderWidth . config)
+    withDisplay $ \d -> io $ do
+        cw <- wa_border_width `fmap` getWindowAttributes d w
+        if cw == 0
+            then setWindowBorderWidth d w bw
+            else setWindowBorderWidth d w 0

XMonad/Actions/OnScreen.hs

@@ -0,0 +1,115 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.OnScreen
+-- Copyright   :  (c) 2009 Nils Schweinsberg
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Control workspaces on different screens (in xinerama mode).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.OnScreen (
+    -- * Usage
+    -- $usage
+    onScreen
+    , viewOnScreen
+    , greedyViewOnScreen
+    , onlyOnScreen
+    ) where
+
+import XMonad.StackSet
+import Control.Monad(guard)
+import Data.List
+import Data.Maybe(fromMaybe)
+import Data.Function(on)
+
+-- $usage
+--
+-- This module provides an easy way to control, what you see on other screens in
+-- xinerama mode without having to focus them. Put this into your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.OnScreen
+--
+-- Then add the appropriate keybindings, for example replace your current keys
+-- to switch the workspaces with this at the bottom of your keybindings:
+--
+-- >     ++
+-- >     [ ((m .|. modm, k), windows (f i))
+-- >       | (i, k) <- zip (workspaces conf) ([xK_1 .. xK_9] ++ [xK_0])
+-- >       , (f, m) <- [ (viewOnScreen 0, 0)
+-- >                   , (viewOnScreen 1, controlMask)
+-- >                   , (greedyView, controlMask .|. shiftMask) ]
+-- >     ]
+--
+-- This will provide you with the following keybindings:
+--
+--      * modkey + 1-0:
+--      Switch to workspace 1-0 on screen 0
+--
+--      * modkey + control + 1-0:
+--      Switch to workspace 1-0 on screen 1
+--
+--      * modkey + control + shift + 1-0:
+--      Default greedyView behaviour
+--
+--
+-- A more basic version inside the default keybindings would be:
+--
+-- >        , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))
+--
+-- where 0 is the first screen and "1" the workspace with the tag "1".
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Switch to the (hidden) workspace with index 'i' on the screen 'sc'.
+-- A default function (for example 'view' or 'greedyView') will be run if 'sc' is
+-- the current screen, no valid screen id or workspace 'i' is already visible.
+onScreen :: (Eq sid, Eq i)
+          => (i -> StackSet i l a sid sd -> StackSet i l a sid sd) -- ^ default action
+          -> sid                      -- ^ screen id
+          -> i                        -- ^ index of the workspace
+          -> StackSet i l a sid sd    -- ^ current stack
+          -> StackSet i l a sid sd
+onScreen defFunc sc i st = fromMaybe (defFunc i st) $ do
+    -- on unfocused current screen
+    guard $ screen (current st) /= sc
+    x <- find ((i==) . tag    ) (hidden  st)
+    s <- find ((sc==) . screen) (screens st)
+    o <- find ((sc==) . screen) (visible st)
+    let newScreen = s { workspace = x }
+    return st { visible   = newScreen : deleteBy ((==) `on` screen) newScreen (visible st)
+              , hidden    = workspace o : deleteBy ((==) `on` tag) x (hidden st)
+              }
+
+-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'greedyView'
+-- to switch the current workspace with workspace 'i'.
+greedyViewOnScreen :: (Eq sid, Eq i)
+    => sid                          -- ^ screen id
+    -> i                            -- ^ index of the workspace
+    -> StackSet i l a sid sd        -- ^ current stack
+    -> StackSet i l a sid sd
+greedyViewOnScreen = onScreen greedyView
+
+-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'view' to
+-- switch focus to the workspace 'i'.
+viewOnScreen :: (Eq sid, Eq i)
+    => sid                          -- ^ screen id
+    -> i                            -- ^ index of the workspace
+    -> StackSet i l a sid sd        -- ^ current stack
+    -> StackSet i l a sid sd
+viewOnScreen = onScreen view
+
+-- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible do nothing.
+onlyOnScreen :: (Eq sid, Eq i)
+    => sid                          -- ^ screen id
+    -> i                            -- ^ index of the workspace
+    -> StackSet i l a sid sd        -- ^ current stack
+    -> StackSet i l a sid sd
+onlyOnScreen = onScreen doNothing
+  where doNothing _ st = st

XMonad/Actions/PerWorkspaceKeys.hs

@@ -0,0 +1,50 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.PerWorkspaceKeys
+-- Copyright   :  (c) Roman Cheplyaka, 2008
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Define key-bindings on per-workspace basis.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PerWorkspaceKeys (
+                                 -- * Usage
+                                 -- $usage
+                                 chooseAction,
+                                 bindOn
+                                ) where
+
+import XMonad
+import XMonad.StackSet as S
+import Data.List (find)
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >  import XMonad.Actions.PerWorkspaceKeys
+--
+-- >   ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")])
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Uses supplied function to decide which action to run depending on current workspace name.
+chooseAction :: (String->X()) -> X()
+chooseAction f = withWindowSet (f . S.currentTag)
+
+-- | If current workspace is listed, run appropriate action (only the first match counts!)
+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.
+bindOn :: [(String, X())] -> X()
+bindOn bindings = chooseAction chooser where
+    chooser ws = case find ((ws==).fst) bindings of
+        Just (_, action) -> action
+        Nothing -> case find ((""==).fst) bindings of
+            Just (_, action) -> action
+            Nothing -> return ()
+

XMonad/Actions/PhysicalScreens.hs

@@ -0,0 +1,88 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.PhysicalScreens
+-- Copyright    : (c) Nelson Elhage <nelhage@mit.edu>
+-- License      : BSD
+--
+-- Maintainer   : Nelson Elhage <nelhage@mit.edu>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Manipulate screens ordered by physical location instead of ID
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PhysicalScreens (
+                                        -- * Usage
+                                        -- $usage
+                                        PhysicalScreen(..)
+                                      , getScreen
+                                      , viewScreen
+                                      , sendToScreen
+                                      ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import qualified Graphics.X11.Xlib as X
+import Graphics.X11.Xinerama
+
+import Data.List (sortBy)
+import Data.Function (on)
+
+{- $usage
+
+This module allows you name Xinerama screens from XMonad using their
+physical location relative to each other (as reported by Xinerama),
+rather than their @ScreenID@ s, which are arbitrarily determined by
+your X server and graphics hardware.
+
+Screens are ordered by the upper-left-most corner, from top-to-bottom
+and then left-to-right.
+
+Example usage in your @~\/.xmonad\/xmonad.hs@ file:
+
+> import XMonad.Actions.PhysicalSCreens
+
+> --
+> -- 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
+> --
+> [((modm .|. mask, key), f sc)
+>     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
+>     , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
+
+For detailed instructions on editing your key bindings, see
+"XMonad.Doc.Extending#Editing_key_bindings".
+ -}
+
+-- | The type of the index of a screen by location
+newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
+
+-- | Translate a physical screen index to a "ScreenId"
+getScreen :: PhysicalScreen -> X (Maybe ScreenId)
+getScreen (P i) = withDisplay $ \dpy -> do
+                    screens <- io $ getScreenInfo dpy
+                    if i >= length screens
+                     then return Nothing
+                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]
+                          in return $ Just $ snd $ ss !! i
+
+-- | Switch to a given physical screen
+viewScreen :: PhysicalScreen -> X ()
+viewScreen p = do i <- getScreen p
+                  whenJust i $ \s -> do
+                  w <- screenWorkspace s
+                  whenJust w $ windows . W.view
+
+-- | Send the active window to a given physical screen
+sendToScreen :: PhysicalScreen -> X ()
+sendToScreen p = do i <- getScreen p
+                    whenJust i $ \s -> do
+                      w <- screenWorkspace s
+                      whenJust w $ windows . W.shift
+
+-- | Compare two screens by their top-left corners, ordering
+-- | top-to-bottom and then left-to-right.
+cmpScreen :: Rectangle -> Rectangle -> Ordering
+cmpScreen  (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)

XMonad/Actions/Plane.hs

@@ -0,0 +1,229 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Plane
+-- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
+--                    Leonardo Serra <leoserra@minaslivre.org>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Marco Túlio Gontijo e Silva <marcot@riseup.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module has functions to navigate through workspaces in a bidimensional
+-- manner.  It allows the organization of workspaces in lines, and provides
+-- functions to move and shift windows in all four directions (left, up, right
+-- and down) possible in a surface.
+--
+-- This functionality was inspired by GNOME (finite) and KDE (infinite)
+-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for
+-- the idea of applying this approach to XMonad.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Plane
+    (
+    -- * Usage
+    -- $usage
+
+    -- * Data types
+    Direction (..)
+    , Limits (..)
+    , Lines (..)
+
+    -- * Key bindings
+    , planeKeys
+
+    -- * Navigating through workspaces
+    , planeShift
+    , planeMove
+    )
+    where
+
+import Control.Monad
+import Data.List
+import Data.Map hiding (split)
+import Data.Maybe
+
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+import XMonad.Util.Run
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.Plane
+-- >
+-- > main = xmonad defaultConfig {keys = myKeys}
+-- >
+-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf
+-- >
+-- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Direction to go in the plane.
+data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Enum
+
+-- | Defines the behaviour when you're trying to move out of the limits.
+data Limits
+    = Finite   -- ^ Ignore the function call, and keep in the same workspace.
+    | Circular -- ^ Get on the other side, like in the Snake game.
+    | Linear   -- ^ The plan comes as a row, so it goes to the next or prev if
+               -- the workspaces were numbered.
+    deriving Eq
+
+-- | The number of lines in which the workspaces will be arranged.  It's
+-- possible to use a number of lines that is not a divisor of the number of
+-- workspaces, but the results are better when using a divisor.  If it's not a
+-- divisor, the last line will have the remaining workspaces.
+data Lines
+    = GConf     -- ^ Use @gconftool-2@ to find out the number of lines.
+    | Lines Int -- ^ Specify the number of lines explicitly.
+
+-- | This is the way most people would like to use this module.  It attaches the
+-- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and
+-- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'.
+-- It also associates these bindings with 'shiftMask' to 'planeShift'.
+planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ())
+planeKeys modm ln limits =
+  fromList $
+  [ ((keyMask, keySym), function ln limits direction)
+  | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft
+  , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)]
+  ]
+
+-- | Shift a window to the next workspace in 'Direction'.  Note that this will
+-- also move to the next workspace.  It's a good idea to use the same 'Lines'
+-- and 'Limits' for all the bindings.
+planeShift :: Lines -> Limits -> Direction -> X ()
+planeShift = plane shift'
+
+shift' ::
+    (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd
+shift' area = greedyView area . shift area
+
+-- | Move to the next workspace in 'Direction'.
+planeMove :: Lines -> Limits -> Direction -> X ()
+planeMove = plane greedyView
+
+plane ::
+    (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
+    X ()
+plane function numberLines_ limits direction = do
+    state <- get
+    xconf <- ask
+
+    numberLines <-
+        liftIO $
+        case numberLines_ of
+            Lines numberLines__ ->
+                return numberLines__
+            GConf               ->
+                do
+                    numberLines__ <-
+                        runProcessWithInput gconftool parameters ""
+                    case reads numberLines__ of
+                        [(numberRead, _)] -> return numberRead
+                        _                 ->
+                            do
+                                trace $
+                                    "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++
+                                    unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1."
+                                return 1
+
+    let
+        notBorder :: Bool
+        notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction
+
+        circular_ :: Int
+        circular_ = circular currentWS
+
+        circular :: Int -> Int
+        circular =
+            [ onLine   pred
+            , onColumn pred
+            , onLine   succ
+            , onColumn succ
+            ]
+            !! fromEnum direction
+
+        linear :: Int -> Int
+        linear =
+            [ onLine   pred . onColumn pred
+            , onColumn pred . onLine pred
+            , onLine   succ . onColumn succ
+            , onColumn succ . onLine succ
+            ]
+            !! fromEnum direction
+
+        onLine :: (Int -> Int) -> Int -> Int
+        onLine f currentWS_
+            | line < areasLine = mod_ columns
+            | otherwise        = mod_ areasColumn
+            where
+                line, column :: Int
+                (line, column) = split currentWS_
+
+                mod_ :: Int -> Int
+                mod_ columns_ = compose line $ mod (f column) columns_
+
+        onColumn :: (Int -> Int) -> Int -> Int
+        onColumn f currentWS_
+            | column < areasColumn || areasColumn == 0  = mod_ numberLines
+            | otherwise                                 = mod_ $ pred numberLines
+            where
+                line, column :: Int
+                (line, column) = split currentWS_
+
+                mod_ :: Int -> Int
+                mod_ lines_ = compose (mod (f line) lines_) column
+
+        compose :: Int -> Int -> Int
+        compose line column = line * columns + column
+
+        split :: Int -> (Int, Int)
+        split currentWS_ =
+            (operation div, operation mod)
+            where
+                operation :: (Int -> Int -> Int) -> Int
+                operation f = f currentWS_ columns
+
+        areasLine :: Int
+        areasLine = div areas columns
+
+        areasColumn :: Int
+        areasColumn = mod areas columns
+
+        columns :: Int
+        columns =
+            if mod areas numberLines == 0 then preColumns else preColumns + 1
+
+        currentWS :: Int
+        currentWS = fromJust mCurrentWS
+
+        preColumns :: Int
+        preColumns = div areas numberLines
+
+        mCurrentWS :: Maybe Int
+        mCurrentWS = elemIndex (currentTag $ windowset state) areaNames
+
+        areas :: Int
+        areas = length areaNames
+
+        run :: (Int -> Int) -> X ()
+        run f = windows $ function $ areaNames !! f currentWS
+
+        areaNames :: [String]
+        areaNames = workspaces $ config xconf
+
+    when (isJust mCurrentWS) $
+        case limits of
+        Finite   -> when notBorder $ run circular
+        Circular -> run circular
+        Linear -> if notBorder then run circular else run linear
+
+gconftool :: String
+gconftool = "gconftool-2"
+
+parameters :: [String]
+parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]

XMonad/Actions/Promote.hs

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Promote
+-- Copyright   :  (c) Miikka Koskinen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  xmonad@s001.ethrael.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Alternate promote function for xmonad.
+--
+-- Moves the focused window to the master pane. All other windows
+-- retain their order. If focus is in the master, swap it with the
+-- next window in the stack. Focus stays in the master.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Promote (
+                                 -- * Usage
+                                 -- $usage
+                                 promote
+                                ) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.Promote
+--
+-- then add a keybinding or substitute 'promote' in place of swapMaster:
+--
+-- >   , ((modm,               xK_Return), promote)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Move the focused window to the master pane. All other windows
+--   retain their order. If focus is in the master, swap it with the
+--   next windo in the stack. Focus stays in the master.
+promote :: X ()
+promote = windows $ modify' $
+          \c -> case c of
+                Stack _ [] []     -> c
+                Stack t [] (x:rs) -> Stack x [] (t:rs)
+                Stack t ls rs     -> Stack t [] (reverse ls ++ rs)

XMonad/Actions/RandomBackground.hs

@@ -0,0 +1,72 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RandomBackground
+-- Copyright   :  (c) 2009 Anze Slosar
+--                translation to Haskell by Adam Vogt
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <vogt.adam@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- An action to start terminals with a random background color
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RandomBackground (
+    -- * Usage
+    -- $usage
+    randomBg',
+    randomBg,
+    RandomColor(HSV,RGB)
+    ) where
+
+import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
+              MonadIO, asks)
+import System.Random
+import Control.Monad(liftM)
+import Numeric(showHex)
+
+-- $usage
+--
+-- Add to your keybindings something like:
+--
+-- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20
+
+-- | RandomColor fixes constraints when generating random colors. All
+-- parameters should be in the range 0 -- 0xff
+data RandomColor = RGB { _colorMin :: Int
+                       , _colorMax :: Int
+                       } -- ^ specify the minimum and maximum lowest values for each color channel.
+                 | HSV { _colorSaturation :: Double
+                       , _colorValue :: Double
+                       } -- ^ specify the saturation and value, leaving the hue random.
+
+toHex :: [Int] -> String
+toHex =  ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex)
+    where ensure x = reverse . take x . (++repeat '0') . reverse
+
+randPermutation ::  (RandomGen g) => [a] -> g -> [a]
+randPermutation xs g = swap $ zip (randoms g) xs
+  where
+    swap ((True,x):(c,y):ys) = y:swap ((c,x):ys)
+    swap ((False,x):ys) = x:swap ys
+    swap x = map snd x
+
+-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
+randomBg' ::  (MonadIO m) => RandomColor -> m String
+randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
+randomBg' (HSV s v) = io $ do
+    g <- newStdGen
+    let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g
+    return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g
+
+-- | @randomBg@ starts a terminal with the background color taken from 'randomBg''
+--
+-- This depends on the your 'terminal' configuration field accepting an
+-- argument like @-bg '#ff0023'@
+randomBg :: RandomColor -> X ()
+randomBg x = do
+    t <- asks (terminal . config)
+    c <- randomBg' x
+    spawn $ t ++ " -bg " ++ c

XMonad/Actions/RotSlaves.hs

@@ -5,17 +5,17 @@
 -- License      : BSD3-style (see LICENSE)
 --
 -- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
--- Stability    : unstable
+-- Stability    : stable
 -- Portability  : unportable
 --
 -- Rotate all windows except the master window and keep the focus in
 -- place.
 -----------------------------------------------------------------------------
 module XMonad.Actions.RotSlaves (
-	-- $usage
-	rotSlaves', rotSlavesUp, rotSlavesDown,
-	rotAll', rotAllUp, rotAllDown
-	) where
+        -- $usage
+        rotSlaves', rotSlavesUp, rotSlavesDown,
+        rotAll', rotAllUp, rotAllDown
+        ) where
 
 import XMonad.StackSet
 import XMonad
@@ -28,7 +28,7 @@ import XMonad
 --
 -- and add whatever keybindings you would like, for example:
 --
--- > , ((modMask x .|. shiftMask, xK_Tab   ), rotSlavesUp)
+-- > , ((modm .|. shiftMask, xK_Tab   ), rotSlavesUp)
 --
 -- This operation will rotate all windows except the master window,
 -- while the focus stays where it is. It is useful together with the

XMonad/Actions/RotView.hs

@@ -1,56 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Actions.RotView
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides bindings to cycle through non-empty workspaces.
---
------------------------------------------------------------------------------
-
-module XMonad.Actions.RotView (
-                              -- * Usage
-                              -- $usage
-                              rotView
-                             ) where
-
-import Data.List ( sortBy, find )
-import Data.Maybe ( isJust )
-import Data.Ord ( comparing )
-
-import XMonad
-import XMonad.StackSet hiding (filter)
-
--- $usage
---
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
---
--- > import XMonad.Actions.RotView
---
--- Then add appropriate key bindings, such as:
---
--- >   , ((modMask x .|. shiftMask, xK_Right), rotView True)
--- >   , ((modMask x .|. shiftMask, xK_Left), rotView False)
---
--- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
-
--- | Cycle through non-empty workspaces.  True --> cycle in the forward
---   direction.  Note that workspaces cycle in order by tag, so if your
---   workspaces are not in tag-order, the cycling might seem wonky.
-rotView :: Bool -> X ()
-rotView forward = do
-    ws <- gets windowset
-    let currentTag = tag . workspace . current $ ws
-        sortWs     = sortBy (comparing tag)
-        isNotEmpty = isJust . stack
-        sorted     = sortWs (hidden ws)
-        pivoted    = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a
-        pivoted'   | forward   = pivoted
-                   | otherwise = reverse pivoted
-        nextws     = find isNotEmpty pivoted'
-    whenJust nextws (windows . view . tag)

XMonad/Actions/Search.hs

@@ -0,0 +1,380 @@
+{- | Module      :  XMonad.Actions.Search
+   Copyright   :  (C) 2007 Gwern Branwen
+   License     :  None; public domain
+
+   Maintainer  :  <gwern0@gmail.com>
+   Stability   :  unstable
+   Portability :  unportable; depends on XSelection, XPrompt
+
+   A module for easily running Internet searches on web sites through xmonad.
+   Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
+
+   Additional sites welcomed. -}
+module XMonad.Actions.Search (   -- * Usage
+                                 -- $usage
+                                 search,
+                                 SearchEngine(..),
+                                 searchEngine,
+                                 searchEngineF,
+                                 promptSearch,
+                                 promptSearchBrowser,
+                                 selectSearch,
+                                 selectSearchBrowser,
+                                 isPrefixOf,
+                                 escape,
+                                 use,
+                                 intelligent,
+                                 (!>),
+                                 prefixAware,
+                                 namedEngine,
+
+                                 amazon,
+                                 alpha,
+                                 codesearch,
+                                 deb,
+                                 debbts,
+                                 debpts,
+                                 dictionary,
+                                 google,
+                                 hackage,
+                                 hoogle,
+                                 images,
+                                 imdb,
+                                 isohunt,
+                                 lucky,
+                                 maps,
+                                 mathworld,
+                                 scholar,
+                                 thesaurus,
+                                 wayback,
+                                 wikipedia,
+                                 wiktionary,
+                                 youtube,
+                                 multi
+                                  -- * Use case: searching with a submap
+                                  -- $tip
+                          ) where
+
+import Data.Char (chr, ord, isAlpha, isMark, isDigit)
+import Data.List (isPrefixOf)
+import Numeric (showIntAtBase)
+import XMonad (X(), MonadIO, liftIO)
+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP)
+import XMonad.Prompt.Shell (getBrowser)
+import XMonad.Util.Run (safeSpawn)
+import XMonad.Util.XSelection (getSelection)
+
+{- $usage
+
+   This module is intended to allow easy access to databases on the
+   Internet through xmonad's interface. The idea is that one wants to
+   run a search but the query string and the browser to use must come
+   from somewhere. There are two places the query string can come from
+   - the user can type it into a prompt which pops up, or the query
+   could be available already in the X Windows copy\/paste buffer
+   (perhaps you just highlighted the string of interest).
+
+   Thus, there are two main functions: 'promptSearch', and
+   'selectSearch' (implemented using the more primitive 'search'). To
+   each of these is passed an engine function; this is a function that
+   knows how to search a particular site.
+
+   For example, the 'google' function knows how to search Google, and
+   so on. You pass 'promptSearch' and 'selectSearch' the engine you
+   want, the browser you want, and anything special they might need;
+   this whole line is then bound to a key of you choosing in your
+   xmonad.hs. For specific examples, see each function.  This module
+   is easily extended to new sites by using 'searchEngine'.
+
+   The currently available search engines are:
+
+* 'amazon' -- Amazon keyword search.
+
+* 'alpha' -- Wolfram|Alpha query.
+
+* 'codesearch' -- Google Labs Code Search search.
+
+* 'deb'    -- Debian package search.
+
+* 'debbts' -- Debian Bug Tracking System.
+
+* 'debpts'  -- Debian Package Tracking System.
+
+* 'dictionary' -- dictionary.reference.com search.
+
+* 'google' -- basic Google search.
+
+* 'hackage' -- Hackage, the Haskell package database.
+
+* 'hoogle' -- Hoogle, the Haskell libraries API search engine.
+
+* 'images' -- Google images.
+
+* 'imdb'   -- the Internet Movie Database.
+
+* 'isohunt' -- isoHunt search.
+
+* 'lucky' -- Google "I'm feeling lucky" search.
+
+* 'maps'   -- Google maps.
+
+* 'mathworld' -- Wolfram MathWorld search.
+
+* 'scholar' -- Google scholar academic search.
+
+* 'thesaurus' -- thesaurus.reference.com search.
+
+* 'wayback' -- the Wayback Machine.
+
+* 'wikipedia' -- basic Wikipedia search.
+
+* 'youtube' -- Youtube video search.
+
+* 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.
+
+Feel free to add more! -}
+
+{- $tip
+
+In combination with "XMonad.Actions.Submap" you can create a powerful
+and easy way to search without adding a whole bunch of bindings.
+
+First import the necessary modules:
+
+> import qualified XMonad.Prompt         as P
+> import qualified XMonad.Actions.Submap as SM
+> import qualified XMonad.Actions.Search as S
+
+Then add the following to your key bindings:
+
+> ...
+> -- Search commands
+> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig)
+> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)
+>
+> ...
+>
+> searchEngineMap method = M.fromList $
+>       [ ((0, xK_g), method S.google)
+>       , ((0, xK_h), method S.hoogle)
+>       , ((0, xK_w), method S.wikipedia)
+>       ]
+
+Or in combination with XMonad.Util.EZConfig:
+
+> ...
+> ] -- end of regular keybindings
+> -- Search commands
+> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ]
+> ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ]
+>
+> ...
+>
+> searchList :: [(String, S.SearchEngine)]
+> searchList = [ ("g", S.google)
+>              , ("h", S.hoohle)
+>              , ("w", S.wikipedia)
+>              ]
+
+Make sure to set firefox to open new pages in a new window instead of
+in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages
+should be opened in...@
+
+Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then
+opens a new firefox window that performs the search on Google, Hoogle
+or Wikipedia respectively.
+
+If you select something in whatever application and hit /mod-shift-s/ +
+/g/\//h/\//w/ it will search the selected string with the specified
+engine.
+
+Happy searching! -}
+
+-- | A customized prompt indicating we are searching, and the name of the site.
+data Search = Search Name
+instance XPrompt Search where
+    showXPrompt (Search name)= "Search [" ++ name ++ "]: "
+
+-- | Escape the search string so search engines understand it.
+-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
+-- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.
+escape :: String -> String
+escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
+         where -- Copied from Network.URI.
+           escapeURIString ::
+               (Char -> Bool)      -- a predicate which returns 'False' if should escape
+               -> String           -- the string to process
+               -> String           -- the resulting URI string
+           escapeURIString = concatMap . escapeURIChar
+           escapeURIChar :: (Char->Bool) -> Char -> String
+           escapeURIChar p c
+               | p c       = [c]
+               | otherwise = '%' : myShowHex (ord c) ""
+               where
+                 myShowHex :: Int -> ShowS
+                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of
+                                    []  -> "00"
+                                    [ch] -> ['0',ch]
+                                    cs  -> cs
+                 toChrHex d
+                   | d < 10    = chr (ord '0' + fromIntegral d)
+                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+
+type Browser      = FilePath
+type Query        = String
+type Site         = String -> String
+type Name         = String
+data SearchEngine = SearchEngine Name Site
+
+-- | Given an already defined search engine, extracts its transformation
+--   function, making it easy to create compound search engines.
+--   For an instance you can use @use google@ to get a function which
+--   makes the same transformation as the google search engine would.
+use :: SearchEngine -> Site
+use (SearchEngine _ engine) = engine
+
+-- | Given a browser, a search engine's transformation function, and a search term, perform the
+--   requested search in the browser.
+search :: Browser -> Site -> Query -> X ()
+search browser site query = safeSpawn browser [site query]
+
+{- | Given a base URL, create the 'SearchEngine' that escapes the query and
+   appends it to the base. You can easily define a new engine locally using
+   exported functions without needing to modify "XMonad.Actions.Search":
+
+> myNewEngine = searchEngine "site" "http://site.com/search="
+
+   The important thing is that the site has a interface which accepts the escaped query
+   string as part of the URL. Alas, the exact URL to feed searchEngine varies
+   from site to site, often considerably, so there\'s no general way to cover this.
+
+   Generally, examining the resultant URL of a search will allow you to reverse-engineer
+   it if you can't find the necessary URL already described in other projects such as Surfraw. -}
+searchEngine :: Name -> String -> SearchEngine
+searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
+
+{- | If your search engine is more complex than this (you may want to identify
+   the kind of input and make the search URL dependent on the input or put the query
+   inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
+
+> searchFunc :: String -> String
+> searchFunc s | s `isPrefixOf` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
+>              | s `isPrefixOf` "http://" = s
+>              | otherwise               = (use google) s
+> myNewEngine = searchEngineF "mymulti" searchFunc
+
+   @searchFunc@ here searches for a word in wikipedia if it has a prefix
+   of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address
+   directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.
+   You can use other engines inside of your own through the 'use' function as shown above to make
+   complex searches.
+
+   The user input will be automatically escaped in search engines created with 'searchEngine',
+   'searchEngineF', however, completely depends on the transformation function passed to it. -}
+searchEngineF :: Name -> Site -> SearchEngine
+searchEngineF = SearchEngine
+
+-- The engines.
+amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
+  images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary,
+  youtube :: SearchEngine
+amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
+alpha      = searchEngine "alpha"      "http://www.wolframalpha.com/input/?i="
+codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
+deb        = searchEngine "deb"        "http://packages.debian.org/"
+debbts     = searchEngine "debbts"     "http://bugs.debian.org/"
+debpts     = searchEngine "debpts"     "http://packages.qa.debian.org/"
+dictionary = searchEngine "dict"       "http://dictionary.reference.com/browse/"
+google     = searchEngine "google"     "http://www.google.com/search?num=100&q="
+hackage    = searchEngine "hackage"    "http://hackage.haskell.org/package/"
+hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="
+images     = searchEngine "images"     "http://images.google.fr/images?q="
+imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="
+isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="
+lucky      = searchEngine "lucky"      "http://www.google.com/search?btnI&q="
+maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
+mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
+scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
+thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
+wikipedia  = searchEngine "wiki"       "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
+wiktionary = searchEngine "wikt"      "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
+youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
+{- This doesn't seem to work, but nevertheless, it seems to be the official
+   method at <http://web.archive.org/collections/web/advanced.html> to get the
+   latest backup. -}
+wayback   = searchEngine "wayback" "http://web.archive.org/"
+
+multi :: SearchEngine
+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
+
+{- | This function wraps up a search engine and creates a new one, which works
+   like the argument, but goes directly to a URL if one is given rather than
+   searching.
+
+> myIntelligentGoogleEngine = intelligent google
+
+   Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
+intelligent :: SearchEngine -> SearchEngine
+intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
+
+-- | > removeColonPrefix "foo://bar" ~> "//bar"
+-- > removeColonPrefix "foo//bar" ~> "foo//bar"
+removeColonPrefix :: String -> String
+removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
+
+{- | Connects a few search engines into one. If the search engines\' names are
+   \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query
+   is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases.
+
+   Example:
+
+> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google))
+
+  Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia,
+  \"mathworld:integral\" will search mathworld, and everything else will fall back to
+  google. The use of intelligent will make sure that URLs are opened directly. -}
+(!>) :: SearchEngine -> SearchEngine -> SearchEngine
+(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s)
+
+{- | Makes a search engine prefix-aware. Especially useful together with '!>'.
+   It will automatically remove the prefix from a query so that you don\'t end
+     up searching for google:xmonad if google is your fallback engine and you
+     explicitly add the prefix. -}
+prefixAware :: SearchEngine -> SearchEngine
+prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s)
+
+{- | Changes search engine's name -}
+namedEngine :: Name -> SearchEngine -> SearchEngine
+namedEngine name (SearchEngine _ site) = searchEngineF name site
+
+{- | Like 'search', but for use with the output from a Prompt; it grabs the
+   Prompt's result, passes it to a given searchEngine and opens it in a given
+   browser. -}
+promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
+promptSearchBrowser config browser (SearchEngine name site) =
+    mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site
+
+{- | Like 'search', but in this case, the string is not specified but grabbed
+ from the user's response to a prompt. Example:
+
+> , ((modm, xK_g), promptSearch greenXPConfig google)
+
+   This specializes "promptSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+promptSearch :: XPConfig -> SearchEngine -> X ()
+promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine
+
+-- | Like 'search', but for use with the X selection; it grabs the selection,
+--   passes it to a given searchEngine and opens it in a given browser.
+selectSearchBrowser :: Browser -> SearchEngine -> X ()
+selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection
+
+{- | Like 'search', but for use with the X selection; it grabs the selection,
+   passes it to a given searchEngine and opens it in the default browser . Example:
+
+> , ((modm .|. shiftMask, xK_g), selectSearch google)
+
+   This specializes "selectSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+selectSearch :: SearchEngine -> X ()
+selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine

XMonad/Actions/SimpleDate.hs

@@ -29,7 +29,7 @@ import XMonad.Util.Run
 --
 -- and add a keybinding, for example:
 --
--- >    , ((modMask x,               xK_d     ), date)
+-- >    , ((modm,               xK_d     ), date)
 --
 -- In this example, a popup date menu will now be bound to @mod-d@.
 --

XMonad/Actions/SinkAll.hs

@@ -1,21 +1,24 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : Xmonad.Actions.SinkAll
+-- Module       : XMonad.Actions.SinkAll
 -- License      : BSD3-style (see LICENSE)
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- Provides a simple binding that pushes all floating windows on the current
--- workspace back into tiling.
+-- Provides a simple binding that pushes all floating windows on the
+-- current workspace back into tiling.  Note that the functionality of
+-- this module has been folded into the more general
+-- "XMonad.Actions.WithAll"; this module simply re-exports the
+-- 'sinkAll' function for backwards compatibility.
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.SinkAll (
     -- * Usage
     -- $usage
+
     sinkAll) where
 
-import XMonad
-import XMonad.StackSet
+import XMonad.Actions.WithAll (sinkAll)
 
 -- $usage
 --
@@ -25,16 +28,7 @@ import XMonad.StackSet
 --
 -- then add a keybinding; for example:
 --
---     , ((modMask x .|. shiftMask, xK_t), sinkAll)
+-- >   , ((modm .|. shiftMask, xK_t), sinkAll)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
-
--- | Un-float all floating windows on the current workspace.
-sinkAll :: X ()
-sinkAll = withAll sink
-
--- | Apply a function to all windows on current workspace.
-withAll :: (Window -> WindowSet -> WindowSet) -> X ()
-withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws
-                             in foldr f ws all'

XMonad/Actions/SpawnOn.hs

@@ -0,0 +1,122 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.SpawnOn
+-- Copyright    : (c) Spencer Janssen
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides a way to modify a window spawned by a command(e.g shift it to the workspace
+-- it was launched on) by using the _NET_WM_PID property that most windows set on creation.
+-- Hence this module won't work on applications that don't set this property.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SpawnOn (
+    -- * Usage
+    -- $usage
+    Spawner,
+    mkSpawner,
+    manageSpawn,
+    spawnHere,
+    spawnOn,
+    spawnAndDo,
+    shellPromptHere,
+    shellPromptOn
+) where
+
+import Data.List (isInfixOf)
+import Data.IORef
+import System.Posix.Types (ProcessID)
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Hooks.ManageHelpers
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.SpawnOn
+--
+-- >    main = do
+-- >      sp <- mkSpawner
+-- >      xmonad defaultConfig {
+-- >         ...
+-- >         manageHook = manageSpawn sp <+> manageHook defaultConfig
+-- >         ...
+-- >      }
+--
+-- To ensure that application appears on a workspace it was launched at, add keybindings like:
+--
+-- >  , ((mod1Mask,xK_o), spawnHere sp "urxvt")
+-- >  , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig)
+--
+-- The module can also be used to apply other manage hooks to the window of
+-- the spawned application(e.g. float or resize it).
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]}
+
+maxPids :: Int
+maxPids = 5
+
+-- | Create 'Spawner' which then has to be passed to other functions.
+mkSpawner :: (Functor m, MonadIO m) => m Spawner
+mkSpawner = io . fmap Spawner $ newIORef []
+
+-- | Provides a manage hook to react on process spawned with
+-- 'spawnOn', 'spawnHere' etc.
+manageSpawn :: Spawner -> ManageHook
+manageSpawn sp = do
+    pids <- io . readIORef $ pidsRef sp
+    mp <- pid
+    case flip lookup pids =<< mp of
+        Nothing -> doF id
+        Just mh  -> do
+            whenJust mp $ \p ->
+                io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst)
+            mh
+
+mkPrompt :: (String -> X ()) -> XPConfig -> X ()
+mkPrompt cb c = do
+    cmds <- io $ getCommands
+    mkXPrompt Shell c (getShellCompl cmds) cb
+
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on current workspace.
+shellPromptHere :: Spawner -> XPConfig -> X ()
+shellPromptHere sp = mkPrompt (spawnHere sp)
+
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on given workspace.
+shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()
+shellPromptOn sp ws = mkPrompt (spawnOn sp ws)
+
+-- | Replacement for 'spawn' which launches
+-- application on current workspace.
+spawnHere :: Spawner -> String -> X ()
+spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd
+
+-- | Replacement for 'spawn' which launches
+-- application on given workspace.
+spawnOn :: Spawner -> WorkspaceId -> String -> X ()
+spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd
+
+-- | Spawn an application and apply the manage hook when it opens.
+spawnAndDo :: Spawner -> ManageHook -> String -> X ()
+spawnAndDo sp mh cmd = do
+    p <- spawnPID $ mangle cmd
+    io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :))
+ where
+    -- TODO this is silly, search for a better solution
+    mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
+              | otherwise = "exec " ++ xs
+    metaChars = "&|;"
+

XMonad/Actions/Submap.hs

@@ -15,9 +15,10 @@
 module XMonad.Actions.Submap (
                              -- * Usage
                              -- $usage
-                             submap
+                             submap,
+                             submapDefault
                             ) where
-
+import Data.Bits
 import XMonad hiding (keys)
 import qualified Data.Map as M
 import Control.Monad.Fix (fix)
@@ -33,7 +34,7 @@ First, import this module into your @~\/.xmonad\/xmonad.hs@:
 
 Allows you to create a sub-mapping of keys. Example:
 
->    , ((modMask x, xK_a), submap . M.fromList $
+>    , ((modm, xK_a), submap . M.fromList $
 >        [ ((0, xK_n),     spawn "mpc next")
 >        , ((0, xK_p),     spawn "mpc prev")
 >        , ((0, xK_z),     spawn "mpc random")
@@ -57,7 +58,11 @@ For detailed instructions on editing your key bindings, see
 --   corresponding action, or does nothing if the key is not found in
 --   the map.
 submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
-submap keys = do
+submap keys = submapDefault (return ()) keys
+
+-- | Like 'submap', but executes a default action if the key did not match.
+submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
+submapDefault def keys = do
     XConf { theRoot = root, display = d } <- ask
 
     io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
@@ -69,8 +74,8 @@ submap keys = do
         if isModifierKey keysym
             then nextkey
             else return (m, keysym)
+    -- Remove num lock mask and Xkb group state bits
+    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
+    maybe def id (M.lookup (m', s) keys)
 
     io $ ungrabKeyboard d currentTime
-
-    m' <- cleanMask m
-    whenJust (M.lookup (m', s) keys) id

XMonad/Actions/SwapWorkspaces.hs

@@ -17,10 +17,16 @@ module XMonad.Actions.SwapWorkspaces (
                                      -- * Usage
                                      -- $usage
                                      swapWithCurrent,
-                                     swapWorkspaces
+                                     swapTo,
+                                     swapWorkspaces,
+                                     Direction1D(..)
                                     ) where
 
+import XMonad (windows, X())
 import XMonad.StackSet
+import XMonad.Actions.CycleWS
+import XMonad.Util.Types
+import XMonad.Util.WorkspaceCompare
 
 
 -- $usage
@@ -31,7 +37,7 @@ import XMonad.StackSet
 -- Then throw something like this in your keys definition:
 --
 -- > ++
--- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i)
+-- > [((modm .|. controlMask, k), windows $ swapWithCurrent i)
 -- >     | (i, k) <- zip workspaces [xK_1 ..]]
 --
 -- After installing this update, if you're on workspace 1, hitting mod-ctrl-5
@@ -43,7 +49,12 @@ import XMonad.StackSet
 -- | Swaps the currently focused workspace with the given workspace tag, via
 --   @swapWorkspaces@.
 swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
-swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s
+swapWithCurrent t s = swapWorkspaces t (currentTag s) s
+
+-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
+-- This is an @X ()@ so can be hooked up to your keybindings directly.
+swapTo :: Direction1D -> X ()
+swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
 
 -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
 --   one with the two corresponding workspaces' tags swapped.

XMonad/Actions/TagWindows.hs

@@ -42,16 +42,16 @@ import XMonad hiding (workspaces)
 --
 -- and add keybindings such as the following:
 --
--- >   , ((modMask x,                 xK_f  ), withFocused (addTag "abc"))
--- >   , ((modMask x .|. controlMask, xK_f  ), withFocused (delTag "abc"))
--- >   , ((modMask x .|. shiftMask,   xK_f  ), withTaggedGlobal "abc" sink)
--- >   , ((modMask x,                 xK_d  ), withTaggedP "abc" (shiftWin "2"))
--- >   , ((modMask x .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)
--- >   , ((modMask x .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")
--- >   , ((modMask x,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))
--- >   , ((modMask x .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)
--- >   , ((modMask x .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
--- >   , ((modWinMask,                xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2")))
+-- >   , ((modm,                 xK_f  ), withFocused (addTag "abc"))
+-- >   , ((modm .|. controlMask, xK_f  ), withFocused (delTag "abc"))
+-- >   , ((modm .|. shiftMask,   xK_f  ), withTaggedGlobalP "abc" W.sink)
+-- >   , ((modm,                 xK_d  ), withTaggedP "abc" (W.shiftWin "2"))
+-- >   , ((modm .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)
+-- >   , ((modm .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")
+-- >   , ((modm,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))
+-- >   , ((modm .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)
+-- >   , ((modm .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
+-- >   , ((modWinMask,                xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2")))
 -- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
 -- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s))
 --
@@ -120,7 +120,7 @@ wsToList ws = crs ++ cls
 wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
 wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])
     where
-        curtag = tag . workspace . current $ ws
+        curtag = currentTag ws
         (crs, cls) = (cms down, cms (reverse . up))
         cms f = maybe [] f (stack . workspace . current $ ws)
         (lws, rws) = (mws (<), mws (>))
@@ -149,8 +149,7 @@ withTagged       t f = withTagged'       t (mapM_ f)
 withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)
 
 withTagged' :: String -> ([Window] -> X ()) -> X ()
-withTagged' t m = gets windowset >>=
-    filterM (hasTag t) . integrate' . stack . workspace . current >>= m
+withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
 
 withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
 withTaggedGlobal' t m = gets windowset >>=
@@ -160,7 +159,7 @@ withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
 withFocusedP f = withFocused $ windows . f
 
 shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
-shiftHere w s = shiftWin (tag . workspace . current $ s) w s
+shiftHere w s = shiftWin (currentTag s) w s
 
 shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
 shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
@@ -193,9 +192,3 @@ tagDelPrompt c = do
 
 tagDelComplList :: X [String]
 tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
-
-
-mkComplFunFromList' :: [String] -> String -> IO [String]
-mkComplFunFromList' l [] = return l
-mkComplFunFromList' l s =
-  return $ filter (\x -> take (length s) x == s) l

XMonad/Actions/TopicSpace.hs

@@ -0,0 +1,317 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.TopicSpace
+-- Copyright   :  (c) Nicolas Pouillard
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Nicolas Pouillard <nicolas.pouillard@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Turns your workspaces into a more topic oriented system.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.TopicSpace
+  (
+  -- * Overview
+  -- $overview
+
+  -- * Usage
+  -- $usage
+   Topic
+  , Dir
+  , TopicConfig(..)
+  , getLastFocusedTopics
+  , setLastFocusedTopic
+  , pprWindowSet
+  , topicActionWithPrompt
+  , topicAction
+  , currentTopicAction
+  , switchTopic
+  , switchNthLastFocused
+  , shiftNthLastFocused
+  , currentTopicDir
+  , checkTopicConfig
+  , (>*>)
+  )
+where
+
+import XMonad
+
+import Data.List
+import Data.Maybe (fromMaybe, isNothing, listToMaybe)
+import Data.Ord
+import qualified Data.Map as M
+import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
+import System.IO
+
+import XMonad.Operations
+import qualified XMonad.StackSet as W
+
+import XMonad.Prompt
+import XMonad.Prompt.Workspace
+
+import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.DynamicLog (PP(..))
+import qualified XMonad.Hooks.DynamicLog as DL
+
+import XMonad.Util.Run (spawnPipe)
+import XMonad.Util.StringProp(getStringListProp,setStringListProp)
+
+-- $overview
+-- This module allows to organize your workspaces on a precise topic basis.  So
+-- instead of having a workspace called `work' you can setup one workspace per
+-- task.  Here we call these workspaces, topics. The great thing with
+-- topics is that one can attach a directory that makes sense to each
+-- particular topic.  One can also attach an action which will be triggered
+-- when switching to a topic that does not have any windows in it.  So you can
+-- attach your mail client to the mail topic, some terminals in the right
+-- directory to the xmonad topic... This package also provides a nice way to
+-- display your topics in an historical way using a custom `pprWindowSet'
+-- function. You can also easily switch to recent topics using this history
+-- of last focused topics.
+
+-- $usage
+-- Here is an example of configuration using TopicSpace:
+--
+-- @
+-- -- The list of all topics/workspaces of your xmonad configuration.
+-- -- The order is important, new topics must be inserted
+-- -- at the end of the list if you want hot-restarting
+-- -- to work.
+-- myTopics :: [Topic]
+-- myTopics =
+--   [ \"dashboard\" -- the first one
+--   , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\"
+--   , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\"
+--   , \"yi\", \"documents\", \"twitter\", \"pdf\"
+--   ]
+-- @
+--
+-- @
+--  myTopicConfig :: TopicConfig
+--  myTopicConfig = TopicConfig
+--    { topicDirs = M.fromList $
+--        [ (\"conf\", \"w\/conf\")
+--        , (\"dashboard\", \"Desktop\")
+--        , (\"yi\", \"w\/dev-haskell\/yi\")
+--        , (\"darcs\", \"w\/dev-haskell\/darcs\")
+--        , (\"haskell\", \"w\/dev-haskell\")
+--        , (\"xmonad\", \"w\/dev-haskell\/xmonad\")
+--        , (\"tools\", \"w\/tools\")
+--        , (\"movie\", \"Movies\")
+--        , (\"talk\", \"w\/talks\")
+--        , (\"music\", \"Music\")
+--        , (\"documents\", \"w\/documents\")
+--        , (\"pdf\", \"w\/documents\")
+--        ]
+--    , defaultTopicAction = const $ spawnShell >*> 3
+--    , defaultTopic = \"dashboard\"
+--    , maxTopicHistory = 10
+--    , topicActions = M.fromList $
+--        [ (\"conf\",       spawnShell >> spawnShellIn \"wd\/ertai\/private\")
+--        , (\"darcs\",      spawnShell >*> 3)
+--        , (\"yi\",         spawnShell >*> 3)
+--        , (\"haskell\",    spawnShell >*> 2 >>
+--                         spawnShellIn \"wd\/dev-haskell\/ghc\")
+--        , (\"xmonad\",     spawnShellIn \"wd\/x11-wm\/xmonad\" >>
+--                         spawnShellIn \"wd\/x11-wm\/xmonad\/contrib\" >>
+--                         spawnShellIn \"wd\/x11-wm\/xmonad\/utils\" >>
+--                         spawnShellIn \".xmonad\" >>
+--                         spawnShellIn \".xmonad\")
+--        , (\"mail\",       mailAction)
+--        , (\"irc\",        ssh somewhere)
+--        , (\"admin\",      ssh somewhere >>
+--                         ssh nowhere)
+--        , (\"dashboard\",  spawnShell)
+--        , (\"twitter\",    spawnShell)
+--        , (\"web\",        spawn browserCmd)
+--        , (\"movie\",      spawnShell)
+--        , (\"documents\",  spawnShell >*> 2 >>
+--                         spawnShellIn \"Documents\" >*> 2)
+--        , (\"pdf\",        spawn pdfViewerCmd)
+--        ]
+--    }
+-- @
+--
+-- @
+--  -- extend your keybindings
+--  myKeys conf\@XConfig{modMask=modm} =
+--    [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
+--    , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
+--    , ((modm              , xK_g     ), promptedGoto)
+--    , ((modm .|. shiftMask, xK_g     ), promptedShift)
+--    ...
+--    ]
+--    ++
+--    [ ((modm, k), switchNthLastFocused myTopicConfig i)
+--    | (i, k) <- zip [1..] workspaceKeys]
+-- @
+--
+-- @
+--  spawnShell :: X ()
+--  spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
+-- @
+--
+-- @
+--  spawnShellIn :: Dir -> X ()
+--  spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\"
+-- @
+--
+-- @
+--  goto :: Topic -> X ()
+--  goto = switchTopic myTopicConfig
+-- @
+--
+-- @
+--  promptedGoto :: X ()
+--  promptedGoto = workspacePrompt myXPConfig goto
+-- @
+--
+-- @
+--  promptedShift :: X ()
+--  promptedShift = workspacePrompt myXPConfig $ windows . W.shift
+-- @
+--
+-- @
+--  myConfig = do
+--      checkTopicConfig myTopics myTopicConfig
+--      myLogHook <- makeMyLogHook
+--      return $ defaultConfig
+--           { borderWidth = 1 -- Width of the window border in pixels.
+--           , workspaces = myTopics
+--           , layoutHook = myModifiers myLayout
+--           , manageHook = myManageHook
+--           , logHook = myLogHook
+--           , handleEventHook = myHandleEventHook
+--           , terminal = myTerminal -- The preferred terminal program.
+--           , normalBorderColor = \"#3f3c6d\"
+--           , focusedBorderColor = \"#4f66ff\"
+--           , XMonad.modMask = mod1Mask
+--           , keys = myKeys
+--           , mouseBindings = myMouseBindings
+--           }
+-- @
+--
+-- @
+--  main :: IO ()
+--  main = xmonad =<< myConfig
+-- @
+
+-- | An alias for @flip replicateM_@
+(>*>) :: Monad m => m a -> Int -> m ()
+(>*>) = flip replicateM_
+infix >*>
+
+-- | 'Topic' is just an alias for 'WorkspaceId'
+type Topic = WorkspaceId
+
+-- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
+type Dir = FilePath
+
+-- | Here is the topic space configuration area.
+data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
+                                 -- ^ This mapping associate a directory to each topic.
+                               , topicActions       :: M.Map Topic (X ())
+                                 -- ^ This mapping associate an action to trigger when
+                                 -- switching to a given topic which workspace is empty.
+                               , defaultTopicAction :: Topic -> X ()
+                                 -- ^ This is the default topic action.
+                               , defaultTopic       :: Topic
+                                 -- ^ This is the default topic.
+                               , maxTopicHistory    :: Int
+                                 -- ^ This setups the maximum depth of topic history, usually
+                                 -- 10 is a good default since we can bind all of them using
+                                 -- numeric keypad.
+                               }
+
+-- | Returns the list of last focused workspaces the empty list otherwise.
+-- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES.
+getLastFocusedTopics :: X [String]
+getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"
+
+-- | Given a 'TopicConfig', the last focused topic, and a predicate that will
+-- select topics that one want to keep, this function will set the property
+-- of last focused topics.
+setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
+setLastFocusedTopic tg w predicate = do
+  disp <- asks display
+  setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES"
+    . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics
+
+-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
+-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
+-- and highlighting topics with urgent windows.
+pprWindowSet :: TopicConfig -> PP -> X String
+pprWindowSet tg pp = do
+    winset <- gets windowset
+    urgents <- readUrgents
+    let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
+        maxDepth = maxTopicHistory tg
+    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)
+                           (`notElem` empty_workspaces)
+    lastWs <- getLastFocusedTopics
+    let depth topic = elemIndex topic lastWs
+        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic
+        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
+        sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)
+    return $ DL.pprWindowSet sortWindows urgents pp' winset
+
+-- | Given a prompt configuration and a topic configuration, triggers the action associated with
+-- the topic given in prompt.
+topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
+topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
+
+-- | Given a configuration and a topic, triggers the action associated with the given topic.
+topicAction :: TopicConfig -> Topic -> X ()
+topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
+
+-- | Trigger the action associated with the current topic.
+currentTopicAction :: TopicConfig -> X ()
+currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset)
+
+-- | Switch to the given topic.
+switchTopic :: TopicConfig -> Topic -> X ()
+switchTopic tg topic = do
+  windows $ W.greedyView topic
+  wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
+  when (null wins) $ topicAction tg topic
+
+-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
+switchNthLastFocused ::TopicConfig -> Int -> X ()
+switchNthLastFocused tg depth = do
+  lastWs <- getLastFocusedTopics
+  switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
+
+-- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
+shiftNthLastFocused :: Int -> X ()
+shiftNthLastFocused n = do
+  ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
+  whenJust ws $ windows . W.shift
+
+-- | Returns the directory associated with current topic returns the empty string otherwise.
+currentTopicDir :: TopicConfig -> X String
+currentTopicDir tg = do
+  topic <- gets (W.tag . W.workspace . W.current . windowset)
+  return . fromMaybe "" . M.lookup topic $ topicDirs tg
+
+-- | Check the given topic configuration for duplicates topics or undefined topics.
+checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
+checkTopicConfig tags tg = do
+    -- tags <- gets $ map W.tag . workspaces . windowset
+
+    let
+      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
+      dups       = tags \\ nub tags
+      diffTopic  = seenTopics \\ sort tags
+      check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
+
+    check diffTopic "Seen but missing topics/workspaces"
+    check dups      "Duplicate topics/workspaces"
+
+-- | Display the given message using the @xmessage@ program.
+xmessage :: String -> IO ()
+xmessage s = do
+  h <- spawnPipe "xmessage -file -"
+  hPutStr h s
+  hClose h

XMonad/Actions/UpdateFocus.hs

@@ -0,0 +1,61 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.UpdateFocus
+-- Copyright   :  (c) Daniel Schoepe
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Daniel Schoepe <asgaroth_@gmx.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Updates the focus on mouse move in unfocused windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.UpdateFocus (
+    -- * Usage
+    -- $usage
+    focusOnMouseMove,
+    adjustEventInput
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import Graphics.X11.Xlib.Extras
+import Control.Monad (when)
+import Data.Monoid
+
+-- $usage
+-- To make the focus update on mouse movement within an unfocused window, add the
+-- following to your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.UpdateFocus
+-- > xmonad $ defaultConfig {
+-- >   ..
+-- >   startupHook = adjustEventInput
+-- >   handleEventHook = focusOnMouseMove
+-- >   ..
+-- > }
+--
+-- This module is probably only useful when focusFollowsMouse is set to True(default).
+
+-- | Changes the focus if the mouse is moved within an unfocused window.
+focusOnMouseMove :: Event -> X All
+focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
+    -- check only every 15 px to avoid excessive calls to translateCoordinates
+    when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
+      dpy <- asks display
+      Just foc <- withWindowSet $ return . W.peek
+      -- get the window under the pointer:
+      (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)
+      when (foc /= w) $ focus w
+    return (All True)
+focusOnMouseMove _ = return (All True)
+
+-- | Adjusts the event mask to pick up pointer movements.
+adjustEventInput :: X ()
+adjustEventInput = withDisplay $ \dpy -> do
+  rootw <- asks theRoot
+  io $ selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask
+                                .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
+                                .|. buttonPressMask .|. pointerMotionMask

XMonad/Actions/UpdatePointer.hs

@@ -0,0 +1,105 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.UpdatePointer
+-- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Robert Marlow <robreim@bobturf.org>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Causes the pointer to follow whichever window focus changes to. Compliments
+-- the idea of switching focus as the mouse crosses window boundaries to
+-- keep the mouse near the currently focused window
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.UpdatePointer
+    (
+     -- * Usage
+     -- $usage
+     updatePointer
+     , PointerPosition (..)
+    )
+    where
+
+import XMonad
+import Control.Monad
+import XMonad.StackSet (member, peek, screenDetail, current)
+import Data.Maybe
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Actions.UpdatePointer
+--
+-- Enable it by including it in your logHook definition. Eg:
+--
+-- > logHook = updatePointer Nearest
+--
+-- which will move the pointer to the nearest point of a newly focused window, or
+--
+-- > logHook = updatePointer (Relative 0.5 0.5)
+--
+-- which will move the pointer to the center of a newly focused window.
+--
+-- To use this with an existing logHook, use >> :
+--
+-- > logHook = dynamicLog
+-- >           >> updatePointer (Relative 1 1)
+--
+-- which moves the pointer to the bottom-right corner of the focused window.
+
+data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational
+    deriving (Read,Show)
+
+-- | Update the pointer's location to the currently focused
+-- window or empty screen unless it's already there, or unless the user was changing
+-- focus with the mouse
+updatePointer :: PointerPosition -> X ()
+updatePointer p = do
+  ws <- gets windowset
+  dpy <- asks display
+  rect <- case peek ws of
+        Nothing -> return $ (screenRect . screenDetail .current) ws
+        Just w  -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
+  root <- asks theRoot
+  mouseIsMoving <- asks mouseFocused
+  (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+  drag <- gets dragging
+  unless (pointWithin (fi rootx) (fi rooty) rect
+          || mouseIsMoving
+          || isJust drag
+          || not (currentWindow `member` ws || currentWindow == none)) $
+    case p of
+    Nearest -> do
+      let x = moveWithin (fi rootx) (rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))
+          y = moveWithin (fi rooty) (rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
+      io $ warpPointer dpy none root 0 0 0 0 x y
+    TowardsCentre xfrc yfrc -> do
+      let cx = fi (rect_width rect) / 2 + fi (rect_x rect)
+          cy = fi (rect_height rect) / 2 + fi (rect_y rect)
+          x,y,cx,cy :: Rational
+          x = moveWithin (fi rootx) (fi $ rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))
+          y = moveWithin (fi rooty) (fi $ rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
+      io $ warpPointer dpy none root 0 0 0 0 (round $ x + xfrc*(cx-x)) (round $ y + yfrc*(cy-y))
+    Relative h v ->
+      io $ warpPointer dpy none root 0 0 0 0
+           (rect_x rect + fraction h (rect_width rect))
+           (rect_y rect + fraction v (rect_height rect))
+        where fraction x y = floor (x * fromIntegral y)
+
+windowAttributesToRectangle :: WindowAttributes -> Rectangle
+windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))     (fi (wa_y wa))
+                                           (fi (wa_width wa)) (fi (wa_height wa))
+moveWithin :: Ord a => a -> a -> a -> a
+moveWithin now lower upper =
+    if now < lower
+    then lower
+    else if now > upper
+         then upper
+         else now
+
+fi :: (Num b, Integral a) => a -> b
+fi = fromIntegral

XMonad/Actions/Warp.hs

@@ -15,6 +15,9 @@
 module XMonad.Actions.Warp (
                            -- * Usage
                            -- $usage
+                           banish,
+                           banishScreen,
+                           Corner(..),
                            warpToScreen,
                            warpToWindow
                           ) where
@@ -31,11 +34,11 @@ You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 
 then add appropriate keybindings to warp the pointer; for example:
 
-> , ((modMask x,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+> , ((modm,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
 >
 >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
 >
->   [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+>   [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2))
 >       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
 
 Note that warping to a particular screen may change the focus.
@@ -44,6 +47,41 @@ Note that warping to a particular screen may change the focus.
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+
+data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight
+
+{- | Move the mouse cursor to a corner of the focused window. Useful for
+   uncluttering things.
+
+   Internally, this uses numerical parameters. We parametrize on the 'Corner'
+   type so the user need not see the violence inherent in
+   the system.
+
+   'warpToScreen' and 'warpToWindow' can be used in a variety of
+   ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
+   which moves the mouse pointer to a corner? warpToWindow can do that! -}
+banish :: Corner -> X ()
+banish direction = case direction of
+                     LowerRight -> warpToWindow 1 1
+                     LowerLeft  -> warpToWindow 0 1
+                     UpperLeft  -> warpToWindow 0 0
+                     UpperRight -> warpToWindow 1 0
+
+{- | Same as 'banish' but moves the mouse to the corner of the
+   currently focused screen -}
+banishScreen :: Corner -> X ()
+banishScreen direction = case direction of
+                           LowerRight -> warpToCurrentScreen 1 1
+                           LowerLeft  -> warpToCurrentScreen 0 1
+                           UpperLeft  -> warpToCurrentScreen 0 0
+                           UpperRight -> warpToCurrentScreen 1 0
+    where
+      warpToCurrentScreen h v =
+          do ws <- gets windowset
+             warpToScreen (W.screen $ current ws) h v
+             windows (const ws)
+
+
 fraction :: (Integral a, Integral b) => Rational -> a -> b
 fraction f x = floor (f * fromIntegral x)
 

XMonad/Actions/WindowBringer.hs

@@ -5,7 +5,7 @@
 -- License     :  BSD-style (see LICENSE)
 --
 -- Maintainer  :  Devin Mullins <me@twifkak.com>
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- dmenu operations to bring windows to you, and bring you to windows.
@@ -15,10 +15,11 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.WindowBringer (
-                                    -- * Usage
-                                    -- $usage
-                                    gotoMenu, bringMenu, windowMapWith
-                                   ) where
+                    -- * Usage
+                    -- $usage
+                    gotoMenu, gotoMenu', bringMenu, windowMap,
+                    bringWindow
+                   ) where
 
 import Data.Char (toLower)
 import qualified Data.Map as M
@@ -26,7 +27,7 @@ import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 import XMonad
 import qualified XMonad as X
-import XMonad.Util.Dmenu (dmenuMap)
+import XMonad.Util.Dmenu (menuMap)
 import XMonad.Util.NamedWindows (getName)
 
 -- $usage
@@ -37,8 +38,8 @@ import XMonad.Util.NamedWindows (getName)
 --
 -- and define appropriate key bindings:
 --
--- > , ((modMask x .|. shiftMask, xK_g     ), gotoMenu)
--- > , ((modMask x .|. shiftMask, xK_b     ), bringMenu)
+-- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
+-- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -47,29 +48,38 @@ import XMonad.Util.NamedWindows (getName)
 -- | Pops open a dmenu with window titles. Choose one, and you will be
 --   taken to the corresponding workspace.
 gotoMenu :: X ()
-gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView)
- where workspaceMap = windowMapWith (W.tag . fst)
+gotoMenu = actionMenu W.focusWindow
+
+gotoMenu' :: String -> X ()
+gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow
 
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
-bringMenu = windowMap >>= actionMenu (windows . bringWindow)
- where windowMap = windowMapWith snd
-       bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
+bringMenu = actionMenu bringWindow
 
--- | Calls dmenuMap to grab the appropriate element from the Map, and hands it
---   off to action if found.
-actionMenu :: (a -> X ()) -> M.Map String a -> X ()
-actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action
+-- | Brings the specified window into the current workspace.
+bringWindow :: Window -> X.WindowSet -> X.WindowSet
+bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
 
--- | Generates a Map from window name to \<whatever you specify\>. For
---   use with dmenuMap.
-windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a)
-windowMapWith value = do -- TODO: extract the pure, creamy center.
+-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
+--   if found.
+actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()
+actionMenu action = actionMenu' "dmenu" action
+
+actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()
+actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
+    where
+      menuMapFunction :: M.Map String a -> X (Maybe a)
+      menuMapFunction selectionMap = menuMap menuCmd selectionMap
+
+-- | A map from window names to Windows.
+windowMap :: X (M.Map String Window)
+windowMap = do
   ws <- gets X.windowset
   M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
  where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
-       keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w
+       keyValuePair ws w = flip (,) w `fmap` decorateName ws w
 
 -- | Returns the window name as will be listed in dmenu.
 --   Lowercased, for your convenience (since dmenu is case-sensitive).

XMonad/Actions/WindowGo.hs

@@ -0,0 +1,184 @@
+{- |
+Module      :  XMonad.Actions.WindowGo
+License     :  Public domain
+
+Maintainer  :  <gwern0@gmail.com>
+Stability   :  unstable
+Portability :  unportable
+
+Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query
+monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can
+find a specified window; you would use this to automatically travel to your
+Firefox or Emacs session, or start a new one (for example), instead of trying to
+remember where you left it or whether you still have one running. -}
+
+module XMonad.Actions.WindowGo (
+                 -- * Usage
+                 -- $usage
+                 raise,
+                 raiseNext,
+                 runOrRaise,
+                 runOrRaiseNext,
+                 raiseMaybe,
+                 raiseNextMaybe,
+
+                 raiseBrowser,
+                 raiseEditor,
+                 runOrRaiseAndDo,
+                 runOrRaiseMaster,
+                 raiseAndDo,
+                 raiseMaster,
+
+                 ifWindows,
+                 ifWindow,
+                 raiseHook,
+                 module XMonad.ManageHook
+                ) where
+
+import Control.Monad
+import Data.Char (toLower)
+import Data.Monoid
+import XMonad (Query(), X(), ManageHook, withWindowSet, runQuery, liftIO, ask)
+import Graphics.X11 (Window)
+import XMonad.ManageHook
+import XMonad.Operations (windows)
+import XMonad.Prompt.Shell (getBrowser, getEditor)
+import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow)
+import XMonad.Util.Run (safeSpawnProg)
+{- $usage
+
+Import the module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.WindowGo
+
+and define appropriate key bindings:
+
+> , ((modm .|. shiftMask, xK_g), raise (className =? "Firefox"))
+> , ((modm .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox"))
+
+(Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\";
+lower versions use other classnames such as \"Firefox-bin\". Either choose the
+appropriate one, or cover your bases by using instead something like
+ @(className =? \"Firefox\" <||> className =? \"Firefox-bin\")@.)
+
+For detailed instructions on editing your key bindings, see
+"XMonad.Doc.Extending#Editing_key_bindings". -}
+
+-- | If windows that satisfy the query exist, apply the supplied
+-- function to them, otherwise run the action given as
+-- second parameter.
+ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
+ifWindows qry f el = withWindowSet $ \wins -> do
+  matches <- filterM (runQuery qry) $ W.allWindows wins
+  case matches of
+    [] -> el
+    ws -> f ws
+
+-- | The same as ifWindows, but applies a ManageHook to the first match
+-- instead and discards the other matches
+ifWindow :: Query Bool -> ManageHook -> X () -> X ()
+ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
+
+-- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
+--   Presumably this executable is the same one that you were looking for.
+runOrRaise :: String -> Query Bool -> X ()
+runOrRaise = raiseMaybe . safeSpawnProg
+
+-- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing.
+raise :: Query Bool -> X ()
+raise = raiseMaybe $ return ()
+
+{- | 'raiseMaybe' queries all Windows based on a boolean provided by the
+   user. Currently, there are 3 such useful booleans defined in
+   "XMonad.ManageHook": 'title', 'resource', 'className'. Each one tests based pretty
+   much as you would think. ManageHook also defines several operators, the most
+   useful of which is (=?). So a useful test might be finding a @Window@ whose
+   class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to
+   pass in a boolean like @(className =? \"Firefox\")@.
+
+   If the boolean returns @True@ on one or more windows, then XMonad will quickly
+   make visible the first result. If no @Window@ meets the criteria, then the
+   first argument comes into play.
+
+   The first argument is an arbitrary IO function which will be executed if the
+   tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs
+   the desired program if it isn't found. But you don't have to do that. Maybe
+   you want to do nothing if the search fails (the definition of 'raise'), or
+   maybe you want to write to a log file, or call some prompt function, or
+   something crazy like that. This hook gives you that flexibility. You can do
+   some cute things with this hook. Suppose you want to do the same thing for
+   Mutt which you just did for Firefox - but Mutt runs inside a terminal window?
+   No problem: you search for a terminal window calling itself \"mutt\", and if
+   there isn't you run a terminal with a command to run Mutt! Here's an example
+   (borrowing 'runInTerm' from "XMonad.Utils.Run"):
+
+  > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
+-}
+raiseMaybe :: X () -> Query Bool -> X ()
+raiseMaybe f qry = ifWindow qry raiseHook f
+
+-- | A manage hook that raises the window.
+raiseHook :: ManageHook
+raiseHook = ask >>= doF . W.focusWindow
+
+-- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches.
+runOrRaiseNext :: String -> Query Bool -> X ()
+runOrRaiseNext = raiseNextMaybe . safeSpawnProg
+
+-- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches.
+raiseNext :: Query Bool -> X ()
+raiseNext = raiseNextMaybe $ return ()
+
+{- | See 'raiseMaybe'.
+     'raiseNextMaybe' is an alternative version that allows cycling
+     through the matching windows. If the focused window matches the
+     query the next matching window is raised. If no matches are found
+     the function f is executed.
+-}
+
+raiseNextMaybe :: X () -> Query Bool -> X ()
+raiseNextMaybe f qry = flip (ifWindows qry) f $ \ws -> do
+  foc <- withWindowSet $ return . W.peek
+  case foc of
+    Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
+                            in windows $ W.focusWindow y
+    _ -> windows . W.focusWindow . head $ ws
+
+-- | Given a function which gets us a String, we try to raise a window with that classname,
+--   or we then interpret that String as a executable name.
+raiseVar :: IO String -> X ()
+raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var)
+
+{- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either
+     take you to the specified program's window, or they try to run it. This is most useful
+     if your variables are simple and look like \"firefox\" or \"emacs\". -}
+raiseBrowser, raiseEditor :: X ()
+raiseBrowser = raiseVar getBrowser
+raiseEditor  = raiseVar getEditor
+
+{- | If the window is found the window is focused and the third argument is called
+     otherwise, the first argument is called
+     See 'raiseMaster' for an example. -}
+raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()
+raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f
+    where afterRaise = ask >>= (>> idHook) . liftX . after
+
+{- | If a window matching the second arugment is found, the window is focused and the third argument is called;
+     otherwise, the first argument is called. -}
+runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()
+runOrRaiseAndDo = raiseAndDo . safeSpawnProg
+
+{- | if the window is found the window is focused and set to master
+     otherwise, the first argument is called.
+
+     > raiseMaster (runInTerm \"-title ghci\"  \"zsh -c \'ghci\'\") (title =? \"ghci\") -}
+raiseMaster :: X () -> Query Bool -> X ()
+raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster)
+
+{- |  If the window is found the window is focused and set to master
+      otherwise, action is run.
+
+      > runOrRaiseMaster \"firefox\" (className =? \"Firefox\"))
+  -}
+runOrRaiseMaster :: String -> Query Bool -> X ()
+runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster)

XMonad/Actions/WindowMenu.hs

@@ -0,0 +1,71 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WindowMenu
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Uses "XMonad.Actions.GridSelect" to display a number of actions related to
+-- window management in the center of the focused window. Actions include: Closing,
+-- maximizing, minimizing and shifting the window to another workspace.
+--
+-- Note: For maximizing and minimizing to actually work, you will need
+-- to integrate "XMonad.Layout.Maximize" and "XMonad.Layout.Minimize" into your
+-- setup.  See the documentation of those modules for more information.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.WindowMenu (
+                             -- * Usage
+                             -- $usage
+                             windowMenu
+                              ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Actions.GridSelect
+import XMonad.Layout.Maximize
+import XMonad.Layout.Minimize
+import XMonad.Util.XUtils (fi)
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.WindowMenu
+--
+-- Then add a keybinding, e.g.
+--
+-- >    , ((modm,               xK_o ), windowMenu)
+
+windowMenu :: X ()
+windowMenu = withFocused $ \w -> do
+    tags <- asks (workspaces . config)
+    Rectangle x y wh ht <- getSize w
+    Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
+    let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
+        originFractY = (fi y - fi sy + fi ht / 2) / fi sht
+        gsConfig = defaultGSConfig
+                    { gs_originFractX = originFractX
+                    , gs_originFractY = originFractY }
+        actions = [ ("Cancel menu", return ())
+                  , ("Close"      , kill)
+                  , ("Maximize"   , sendMessage $ maximizeRestore w)
+                  , ("Minimize"   , sendMessage $ MinimizeWin w)
+                  ] ++
+                  [ ("Move to " ++ tag, windows $ W.shift tag)
+                    | tag <- tags ]
+    runSelectedAction gsConfig actions
+
+getSize :: Window -> X (Rectangle)
+getSize w = do
+  d  <- asks display
+  wa <- io $ getWindowAttributes d w
+  let x = fi $ wa_x wa
+      y = fi $ wa_y wa
+      wh = fi $ wa_width wa
+      ht = fi $ wa_height wa
+  return (Rectangle x y wh ht)

XMonad/Actions/WindowNavigation.hs

@@ -0,0 +1,216 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WindowNavigation
+-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,
+--                          Devin Mullins <me@twifkak.com>
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- License     :  BSD3-style (see LICENSE)
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This is a rewrite of "XMonad.Layout.WindowNavigation".  WindowNavigation
+-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian
+-- window coordinates, rather than just going j\/k on the stack.
+--
+-- This module is experimental. You'll have better luck with the original.
+--
+-- This module differs from the other in a few ways:
+--
+--   (1) You can go up\/down\/left\/right across multiple screens.
+--
+--   (2) It doesn't provide little border colors for your neighboring windows.
+--
+--   (3) It doesn't provide the \'Move\' action, which seems to be related to
+--      the XMonad.Layout.Combo extension.
+--
+--   (4) It tries to be slightly smarter about tracking your current position.
+--
+--   (5) Configuration is different.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.WindowNavigation (
+                                       -- * Usage
+                                       -- $usage
+                                       withWindowNavigation,
+                                       withWindowNavigationKeys,
+                                       WNAction(..),
+                                       go, swap,
+                                       Direction2D(..)
+                                       ) where
+
+import XMonad
+import XMonad.Util.Types (Direction2D(..))
+import qualified XMonad.StackSet as W
+
+import Control.Applicative ((<$>))
+import Control.Arrow (second)
+import Data.IORef
+import Data.List (sortBy)
+import Data.Map (Map())
+import qualified Data.Map as M
+import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
+import Data.Ord (comparing)
+import qualified Data.Set as S
+import Graphics.X11.Xlib
+
+-- $usage
+--
+-- To use it, you're going to apply the 'withWindowNavigation' function.
+-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use
+-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog".
+-- In particular:
+--
+-- > main = do
+-- >     config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
+-- >             $ defaultConfig { ... }
+-- >     xmonad config
+--
+-- Here, we pass in the keys for navigation in counter-clockwise order from up.
+-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@
+-- to swap windows.
+--
+-- If you want more flexibility over your keybindings, you can use
+-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather
+-- than a tuple of the four directional keys. See the source code of
+-- 'withWindowNavigation' for an example.
+
+-- TODO:
+--  - monad for WNState?
+--  - cleanup (including inr)
+--  - more documentation
+--  - tests? (esp. for edge cases in currentPosition)
+--  - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2
+--  - solve the 2+3, middle right to bottom left problem
+--  - command to iteratively swapUp/swapDown instead of directly swapping with target
+--  - manageHook to draw window decos?
+
+withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
+withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} =
+    withWindowNavigationKeys [ ((modm              , u), WNGo   U),
+                               ((modm              , l), WNGo   L),
+                               ((modm              , d), WNGo   D),
+                               ((modm              , r), WNGo   R),
+                               ((modm .|. shiftMask, u), WNSwap U),
+                               ((modm .|. shiftMask, l), WNSwap L),
+                               ((modm .|. shiftMask, d), WNSwap D),
+                               ((modm .|. shiftMask, r), WNSwap R) ]
+                             conf
+
+withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
+withWindowNavigationKeys wnKeys conf = do
+    posRef <- newIORef M.empty
+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
+                                 `M.union` keys conf cnf,
+                  logHook = logHook conf >> trackMovement posRef }
+  where fromWNAction posRef (WNGo dir)   = go   posRef dir
+        fromWNAction posRef (WNSwap dir) = swap posRef dir
+
+data WNAction = WNGo Direction2D | WNSwap Direction2D
+
+type WNState = Map WorkspaceId Point
+
+-- go:
+-- 1. get current position, verifying it matches the current window
+-- 2. get target windowrect
+-- 3. focus window
+-- 4. set new position
+go :: IORef WNState -> Direction2D -> X ()
+go = withTargetWindow W.focusWindow
+
+swap :: IORef WNState -> Direction2D -> X ()
+swap = withTargetWindow swapWithFocused
+  where swapWithFocused targetWin winSet =
+            case W.peek winSet of
+                Just currentWin -> W.focusWindow currentWin $
+                                   mapWindows (swapWin currentWin targetWin) winSet
+                Nothing -> winSet
+        mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
+        mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
+        mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
+        swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
+
+withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
+withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
+    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
+    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
+      windows (adj targetWin)
+      setPosition posRef pos targetRect
+
+trackMovement :: IORef WNState -> X ()
+trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
+                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)
+
+fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
+fromCurrentPoint posRef f = withFocused $ \win -> do
+                                currentPosition posRef >>= f win
+
+-- Gets the current position from the IORef passed in, or if nothing (say, from
+-- a restart), derives the current position from the current window. Also,
+-- verifies that the position is congruent with the current window (say, if you
+-- used mod-j/k or mouse or something).
+currentPosition :: IORef WNState -> X Point
+currentPosition posRef = do
+    root <- asks theRoot
+    currentWindow <- gets (W.peek . windowset)
+    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
+
+    wsid <- gets (W.currentTag . windowset)
+    mp <- M.lookup wsid <$> io (readIORef posRef)
+
+    return $ maybe (middleOf currentRect) (`inside` currentRect) mp
+
+  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
+
+setPosition :: IORef WNState -> Point -> Rectangle -> X ()
+setPosition posRef oldPos newRect = do
+    wsid <- gets (W.currentTag . windowset)
+    io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
+
+inside :: Point -> Rectangle -> Point
+Point x y `inside` Rectangle rx ry rw rh =
+    Point (x `within` (rx, rw)) (y `within` (ry, rh))
+  where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
+                                    then pos
+                                    else midPoint lower dim
+
+midPoint :: Position -> Dimension -> Position
+midPoint pos dim = pos + fromIntegral dim `div` 2
+
+navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
+navigableTargets point dir = navigable dir point <$> windowRects
+
+-- Filters and sorts the windows in terms of what is closest from the Point in
+-- the Direction2D.
+navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
+navigable d pt = sortby d . filter (inr d pt . snd)
+
+-- Produces a list of normal-state windows, on any screen. Rectangles are
+-- adjusted based on screen position relative to the current screen, because I'm
+-- bad like that.
+windowRects :: X [(Window, Rectangle)]
+windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
+
+windowRect :: Window -> X (Maybe (Window, Rectangle))
+windowRect win = withDisplay $ \dpy -> do
+    (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+    return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    `catchX` return Nothing
+
+-- Modified from droundy's implementation of WindowNavigation:
+
+inr :: Direction2D -> Point -> Rectangle -> Bool
+inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
+                                                        py < ry + fromIntegral h
+inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
+                                            py >  ry
+inr R (Point px py) (Rectangle rx ry _ h) = px <  rx &&
+                                            py >= ry && py < ry + fromIntegral h
+inr L (Point px py) (Rectangle rx ry w h) =             px > rx + fromIntegral w &&
+                                            py >= ry && py < ry + fromIntegral h
+
+sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
+sortby D = sortBy $ comparing (rect_y . snd)
+sortby R = sortBy $ comparing (rect_x . snd)
+sortby U = reverse . sortby D
+sortby L = reverse . sortby R

XMonad/Actions/WithAll.hs

@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.WithAll
+-- License      : BSD3-style (see LICENSE)
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides functions for performing a given action on all windows of
+-- the current workspace.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.WithAll (
+    -- * Usage
+    -- $usage
+    sinkAll, withAll,
+    withAll', killAll) where
+
+import Data.Foldable hiding (foldr)
+
+import XMonad
+import XMonad.Core
+import XMonad.Operations
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.WithAll
+--
+-- then add a keybinding; for example:
+--
+--     , ((modm .|. shiftMask, xK_t), sinkAll)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Un-float all floating windows on the current workspace.
+sinkAll :: X ()
+sinkAll = withAll' sink
+
+-- | Apply a function to all windows on the current workspace.
+withAll' :: (Window -> WindowSet -> WindowSet) -> X ()
+withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws
+                              in foldr f ws all'
+
+-- | Execute an 'X' action for each window on the current workspace.
+withAll :: (Window -> X ()) -> X()
+withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws
+                                   in forM_ all' f
+
+-- | Kill all the windows on the current workspace.
+killAll :: X()
+killAll = withAll killWindow

XMonad/Actions/WmiiActions.hs

@@ -1,106 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonad.Actions.WmiiActions
--- Copyright    : (c) Juraj Hercek <juhe_xmonad@hck.sk>
--- License      : BSD3
---
--- Maintainer   : Juraj Hercek <juhe_xmonad@hck.sk>
--- Stability    : unstable
--- Portability  : unportable
---
--- Provides \"actions\" as in the Wmii window manager
--- (<http://wmii.suckless.org>). It also provides a slightly better
--- interface for running dmenu on xinerama screens. If you want to use
--- xinerama functions, you have to apply the following patch (see the
--- "XMonad.Util.Dmenu" module):
--- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>.  Don't
--- forget to recompile dmenu afterwards ;-).
------------------------------------------------------------------------------
-
-module XMonad.Actions.WmiiActions (
-                                 -- * Usage
-                                 -- $usage
-                                   wmiiActions
-                                 , wmiiActionsXinerama
-                                 , executables
-                                 , executablesXinerama
-                                 ) where
-
-import XMonad
-import XMonad.Util.Dmenu (dmenu, dmenuXinerama)
-import XMonad.Util.Run (runProcessWithInput)
-
-import Control.Monad (filterM, liftM, liftM2)
-import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable)
-
--- $usage
---
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
---
--- > import XMonad.Actions.WmiiActions
---
---  and add something like the following to your key bindings:
---
--- > ,((modMask x, xK_a), wmiiActions "/home/joe/.wmii-3.5/")
---
--- or, if you are using xinerama, you can use
---
--- > ,((modMask x, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/")
---
--- However, make sure you also have the xinerama build of dmenu (for more
--- information see the "XMonad.Util.Dmenu" extension).
---
--- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
-
--- | The 'wmiiActions' function takes the file path as a first argument and
--- executes dmenu with all the executables found in the provided path.
-wmiiActions :: FilePath -> X ()
-wmiiActions path =
-        wmiiActionsDmenu path dmenu
-
--- | The 'wmiiActionsXinerama'  does the same as 'wmiiActions', but it shows
--- dmenu only on the currently focused workspace.
-wmiiActionsXinerama :: FilePath -> X ()
-wmiiActionsXinerama path =
-        wmiiActionsDmenu path dmenuXinerama
-
-wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X ()
-wmiiActionsDmenu path dmenuBrand =
-        let path' = path ++ "/" in
-        getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++)
-
-getExecutableFileList :: FilePath -> X [String]
-getExecutableFileList path =
-        io $ getDirectoryContents path >>=
-             filterM (\x -> let x' = path ++ x in
-                            liftM2 (&&)
-                              (doesFileExist x')
-                              (liftM executable (getPermissions x')))
-
-{-
-getExecutableFileList :: FilePath -> X [String]
-getExecutableFileList path =
-        io $ getDirectoryContents path >>=
-             filterM (doesFileExist . (path ++)) >>=
-             filterM (liftM executable . getPermissions . (path ++))
--}
-
--- | The 'executables' function runs the dmenu_path script, providing list of
--- executable files accessible from the $PATH variable.
-executables :: X ()
-executables = executablesDmenu dmenu
-
--- | The 'executablesXinerama' function does the same as the
--- 'executables' function, but on the workspace which currently has focus.
-executablesXinerama :: X ()
-executablesXinerama = executablesDmenu dmenuXinerama
-
-executablesDmenu :: ([String] -> X String) -> X ()
-executablesDmenu dmenuBrand =
-        getExecutablesList >>= dmenuBrand >>= spawn
-
-getExecutablesList :: X [String]
-getExecutablesList =
-        io $ liftM lines $ runProcessWithInput "dmenu_path" [] ""
-

XMonad/Actions/WorkspaceCursors.hs

@@ -0,0 +1,219 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.WorkspaceCursors
+-- Copyright    : (c) 2009 Adam Vogt <vogt.adam@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Adam Vogt
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.WorkspaceCursors
+    (
+    -- * Usage
+    -- $usage
+
+     focusDepth
+    ,makeCursors
+    ,toList
+    ,workspaceCursors
+
+    ,WorkspaceCursors
+    ,getFocus
+
+    -- * Modifying the focus
+    ,modifyLayer
+    ,modifyLayer'
+    ,shiftModifyLayer,shiftLayer
+
+    -- * Functions to pass to 'modifyLayer'
+    ,focusNth'
+    ,noWrapUp,noWrapDown
+
+    -- * Todo
+    -- $todo
+    ) where
+
+import qualified XMonad.StackSet as W
+
+import XMonad.Actions.FocusNth(focusNth')
+import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
+                                    LayoutModifier(handleMess, redoLayout))
+import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
+              fromMessage, sendMessage, windows, gets)
+import Control.Monad((<=<), guard, liftM, liftM2, when)
+import Control.Applicative((<$>))
+import Data.Foldable(Foldable(foldMap), toList)
+import Data.Maybe(fromJust, listToMaybe)
+import Data.Monoid(Monoid(mappend, mconcat))
+import Data.Traversable(sequenceA)
+
+-- $usage
+--
+-- Here is an example config:
+--
+-- > import XMonad
+-- > import XMonad.Actions.WorkspaceCursors
+-- > import XMonad.Hooks.DynamicLog
+-- > import XMonad.Util.EZConfig
+-- > import qualified XMonad.StackSet as W
+-- >
+-- > main = do
+-- >     x <- xmobar conf
+-- >     xmonad x
+-- >
+-- > conf = additionalKeysP defaultConfig
+-- >        { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig
+-- >        , workspaces = toList myCursors } $
+-- >        [("M-"++shift++control++[k], f direction depth)
+-- >          | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]
+-- >          , (direction,control) <- zip [W.focusUp',W.focusDown'] ["C-",""]
+-- >          , (depth,k) <- zip (reverse [1..focusDepth myCursors]) "asdf"]
+-- >        ++ moreKeybindings
+-- >
+-- > moreKeybindings = []
+-- >
+-- > myCursors = makeCursors $ map (map (\x -> [x])) [ "1234", "abc", "xyz"]
+-- > -- myCursors = makeCursors [["wsA","wsB","wsC"],["-alpha-","-beta-","-gamma-"],["x","y"]]
+
+
+-- $todo
+--
+-- * Find and document how to raise the allowable length of arguments:
+--   restoring xmonad's state results in: @xmonad: executeFile: resource
+--   exhausted (Argument list too long)@ when you specify more than about 50
+--   workspaces. Or change it such that workspaces are created when you try to
+--   view it.
+--
+-- * Function for pretty printing for DynamicLog that groups workspaces by
+-- common prefixes
+--
+-- * Examples of adding workspaces to the cursors, having them appear multiple
+--   times for being able to show jumping to some n'th multiple workspace
+
+-- | makeCursors requires a nonempty string, and each sublist must be nonempty
+makeCursors ::  [[String]] -> Cursors String
+makeCursors [] = error "Workspace Cursors cannot be empty"
+makeCursors a = concat . reverse <$> foldl addDim x xs
+    where x = end $ map return $ head a
+          xs = map (map return) $ tail a
+          -- this could probably be simplified, but this true:
+          -- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
+          -- the strange order is used because it makes the regular M-1..9
+          -- bindings change the prefixes first
+
+addDim ::  (Monoid a) => Cursors a -> [a] -> Cursors a
+addDim prev prefixes = Cons . fromJust . W.differentiate
+            $ map ((<$> prev) . mappend) prefixes
+
+end :: [a] -> Cursors a
+end = Cons . fromJust . W.differentiate . map End
+
+data Cursors a
+    = Cons (W.Stack (Cursors a))
+    | End a deriving (Eq,Show,Read,Typeable)
+
+instance Foldable Cursors where
+    foldMap f (End x) = f x
+    foldMap f (Cons (W.Stack x y z)) = foldMap f x `mappend` mconcat (map (foldMap f) $ reverse y ++ z)
+
+instance Functor Cursors where
+    fmap f (End a) = End $ f a
+    fmap f (Cons (W.Stack x y z)) = Cons $ W.Stack (fmap f x) (fmap (fmap f) y) (fmap (fmap f) z)
+
+changeFocus ::  (Cursors t -> Bool) -> Cursors t -> [Cursors t]
+changeFocus p (Cons x) = do
+    choose <- chFocus p x
+    foc    <- changeFocus p $ W.focus choose
+    return . Cons $ choose { W.focus = foc }
+changeFocus p x = guard (p x) >> return x
+
+chFocus :: (a -> Bool) -> W.Stack a -> [W.Stack a]
+chFocus p st = filter (p . W.focus) $ zipWith const (iterate W.focusDown' st) (W.integrate st)
+
+getFocus ::  Cursors b -> b
+getFocus (Cons x) = getFocus $ W.focus x
+getFocus (End x) = x
+
+-- This could be made more efficient, if the fact that the suffixes are grouped
+focusTo ::  (Eq t) => t -> Cursors t -> Maybe (Cursors t)
+focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)
+
+-- | non-wrapping version of 'W.focusUp''
+noWrapUp ::  W.Stack t -> W.Stack t
+noWrapUp (W.Stack t (l:ls) rs) = W.Stack l ls (t:rs)
+noWrapUp x@(W.Stack _ []   _ ) = x
+
+-- | non-wrapping version of 'W.focusDown''
+noWrapDown ::  W.Stack t -> W.Stack t
+noWrapDown = reverseStack . noWrapUp . reverseStack
+    where reverseStack (W.Stack t ls rs) = W.Stack t rs ls
+
+focusDepth ::  Cursors t -> Int
+focusDepth (Cons x) = 1 + focusDepth (W.focus x)
+focusDepth (End  _) = 0
+
+descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
+descend f 1 (Cons x) = Cons `liftM` f x
+descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x
+descend _ _ x = return x
+
+onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
+onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)
+
+-- | @modifyLayer@ is used to change the focus at a given depth
+modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
+modifyLayer f depth = modifyCursors (descend (return . f) depth)
+
+-- | @shiftModifyLayer@ is the same as 'modifyLayer', but also shifts the
+-- currently focused window to the new workspace
+shiftModifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X ()
+shiftModifyLayer f = modifyLayer' $ \st -> do
+    let st' = f st
+    windows $ W.shift $ getFocus (Cons st')
+    return st'
+
+-- | @shiftLayer@ is the same as 'shiftModifyLayer', but the focus remains on
+-- the current workspace.
+shiftLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors WorkspaceId))-> Int-> X ()
+shiftLayer f = modifyLayer' $ \st -> do
+    windows $ W.shift $ getFocus $ Cons $ f st
+    return st
+
+-- | example usages are 'shiftLayer' and 'shiftModifyLayer'
+modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> Int -> X ()
+modifyLayer' f depth = modifyCursors (descend f depth)
+
+modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()
+modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)
+
+data WorkspaceCursors a = WorkspaceCursors (Cursors String)
+    deriving (Typeable,Read,Show)
+
+-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
+-- your outermost modifier, unless you want different cursors at different
+-- times (using "XMonad.Layout.MultiToggle")
+workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
+workspaceCursors = ModifiedLayout . WorkspaceCursors
+
+data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
+    deriving (Typeable)
+
+instance Message ChangeCursors
+
+updateXMD ::  Cursors WorkspaceId -> X ()
+updateXMD cs = do
+    changed <- gets $ (getFocus cs /=) . W.currentTag . windowset
+    when changed $ windows $ W.greedyView $ getFocus cs
+
+instance LayoutModifier WorkspaceCursors a where
+    redoLayout (WorkspaceCursors cs) _ _ arrs = do
+        cws <- gets $ W.currentTag . windowset
+        return (arrs,WorkspaceCursors <$> focusTo cws cs)
+
+    handleMess (WorkspaceCursors cs) m =
+        sequenceA $ fmap WorkspaceCursors . ($ cs) . unWrap <$> fromMessage m

XMonad/Config/Arossato.hs

@@ -17,26 +17,32 @@ module XMonad.Config.Arossato
     ( -- * Usage
       -- $usage
       arossatoConfig
-    , arossatoTabbedConfig
     ) where
 
 import qualified Data.Map as M
 
-import XMonad
-import XMonad.ManageHook
+import XMonad hiding ( (|||) )
 import qualified XMonad.StackSet as W
 
 import XMonad.Actions.CycleWS
-import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.DynamicLog hiding (xmobar)
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ServerMode
 import XMonad.Layout.Accordion
+import XMonad.Layout.LayoutCombinators
 import XMonad.Layout.Magnifier
 import XMonad.Layout.NoBorders
+import XMonad.Layout.SimpleFloat
 import XMonad.Layout.Tabbed
+import XMonad.Layout.WindowArranger
 import XMonad.Prompt
 import XMonad.Prompt.Shell
 import XMonad.Prompt.Ssh
+import XMonad.Prompt.Theme
 import XMonad.Prompt.Window
 import XMonad.Prompt.XMonad
+import XMonad.Util.Run
+import XMonad.Util.Themes
 
 -- $usage
 -- The simplest way to use this configuration module is to use an
@@ -48,8 +54,12 @@ import XMonad.Prompt.XMonad
 -- > import XMonad.Config.Arossato (arossatoConfig)
 -- >
 -- > main :: IO ()
--- > main = xmonad arossatoConfig
+-- > main = xmonad =<< arossatoConfig
 --
+-- NOTE: that I'm using xmobar and, if you don't have xmobar in your
+-- PATH, this configuration will produce an error and xmonad will not
+-- start. If you don't want to install xmobar get rid of this line at
+-- the beginning of 'arossatoConfig'.
 --
 -- You can use this module also as a starting point for writing your
 -- own configuration module from scratch. Save it as your
@@ -61,7 +71,6 @@ import XMonad.Prompt.XMonad
 -- >     ( -- * Usage
 -- >       -- $usage
 -- >       arossatoConfig
--- >     , arossatoTabbedConfig
 -- >     ) where
 --
 -- to
@@ -70,51 +79,52 @@ import XMonad.Prompt.XMonad
 --
 -- 2. Add a line like:
 --
--- > main = xmonad arossatoConfig
+-- > main = xmonad =<< arossatoConfig
 --
 -- 3. Start playing with the configuration options...;)
 
--- | My configuration for the Tabbed Layout. Basically this is the
--- Ion3 clean style.
-arossatoTabbedConfig :: TConf
-arossatoTabbedConfig =
-    defaultTConf { activeColor         = "#8a999e"
-                 , inactiveColor       = "#545d75"
-                 , activeBorderColor   = "white"
-                 , inactiveBorderColor = "grey"
-                 , activeTextColor     = "white"
-                 , inactiveTextColor   = "grey"
-                 , tabSize             = 15
-                 }
-
-arossatoConfig = defaultConfig
+arossatoConfig = do
+    xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed!
+    return $ defaultConfig
          { workspaces         = ["home","var","dev","mail","web","doc"] ++
                                 map show [7 .. 9 :: Int]
-         , logHook            = dynamicLogXmobar
+         , logHook            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
          , manageHook         = newManageHook
-         , layoutHook         = noBorders mytab |||
-                                magnifier tiled |||
-                                noBorders Full  |||
-                                tiled           |||
-                                Mirror tiled    |||
-                                Accordion
+         , layoutHook         = avoidStruts $
+                                decorated        |||
+                                noBorders mytabs |||
+                                otherLays
          , terminal           = "urxvt +sb"
          , normalBorderColor  = "white"
          , focusedBorderColor = "black"
          , keys               = newKeys
-         , defaultGaps        = [(15,0,0,0)]
+         , handleEventHook    = serverModeEventHook
+         , focusFollowsMouse  = False
          }
     where
       -- layouts
-      mytab = tabbed shrinkText arossatoTabbedConfig
-      tiled = Tall 1 (3/100) (1/2)
+      mytabs    =       tabbed shrinkText (theme smallClean)
+      decorated = simpleFloat' shrinkText (theme smallClean)
+      tiled     = Tall 1 (3/100) (1/2)
+      otherLays = windowArrange   $
+                  magnifier tiled |||
+                  noBorders Full  |||
+                  Mirror tiled    |||
+                  Accordion
 
       -- manageHook
-      myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat
-                                 , resource =? "win"          --> doF (W.shift "doc") -- xpdf
+      myManageHook  = composeAll [ resource =? "win"          --> doF (W.shift "doc") -- xpdf
                                  , resource =? "firefox-bin"  --> doF (W.shift "web")
                                  ]
-      newManageHook = myManageHook <+> manageHook defaultConfig
+      newManageHook = myManageHook
+
+      -- xmobar
+      myDynLog    h = dynamicLogWithPP defaultPP
+                      { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
+                      , ppTitle   = xmobarColor "green"  "" . shorten 40
+                      , ppVisible = wrap "(" ")"
+                      , ppOutput  = hPutStrLn h
+                      }
 
       -- key bindings stuff
       defKeys    = keys defaultConfig
@@ -136,8 +146,9 @@ arossatoConfig = defaultConfig
           [ ((modMask x              , xK_F12   ), xmonadPrompt      defaultXPConfig     )
           , ((modMask x              , xK_F3    ), shellPrompt       defaultXPConfig     )
           , ((modMask x              , xK_F4    ), sshPrompt         defaultXPConfig     )
-          , ((modMask x              , xK_F5    ), windowPromptGoto  defaultXPConfig     )
-          , ((modMask x              , xK_F6    ), windowPromptBring defaultXPConfig     )
+          , ((modMask x              , xK_F5    ), themePrompt       defaultXPConfig     )
+          , ((modMask x              , xK_F6    ), windowPromptGoto  defaultXPConfig     )
+          , ((modMask x              , xK_F7    ), windowPromptBring defaultXPConfig     )
           , ((modMask x              , xK_comma ), prevWS                                )
           , ((modMask x              , xK_period), nextWS                                )
           , ((modMask x              , xK_Right ), windows W.focusDown                   )
@@ -155,6 +166,20 @@ arossatoConfig = defaultConfig
           , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)
           , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )
           , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )
+          -- windowArranger
+          , ((modMask x .|. controlMask              , xK_a    ), sendMessage  Arrange           )
+          , ((modMask x .|. controlMask .|. shiftMask, xK_a    ), sendMessage  DeArrange         )
+          , ((modMask x .|. controlMask              , xK_Left ), sendMessage (DecreaseLeft   10))
+          , ((modMask x .|. controlMask              , xK_Up   ), sendMessage (DecreaseUp     10))
+          , ((modMask x .|. controlMask              , xK_Right), sendMessage (IncreaseRight  10))
+          , ((modMask x .|. controlMask              , xK_Down ), sendMessage (IncreaseDown   10))
+          , ((modMask x .|. shiftMask                , xK_Left ), sendMessage (MoveLeft       10))
+          , ((modMask x .|. shiftMask                , xK_Right), sendMessage (MoveRight      10))
+          , ((modMask x .|. shiftMask                , xK_Down ), sendMessage (MoveDown       10))
+          , ((modMask x .|. shiftMask                , xK_Up   ), sendMessage (MoveUp         10))
+          -- gaps
+          , ((modMask x                              , xK_b    ), sendMessage  ToggleStruts      )
+
           ] ++
           -- Use modMask .|. shiftMask .|. controlMask 1-9 instead
           [( (m .|. modMask x, k), windows $ f i)

XMonad/Config/Azerty.hs

@@ -0,0 +1,48 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Azerty
+-- Copyright    : (c) Devin Mullins <me@twifkak.com>
+-- License      : BSD
+--
+-- Maintainer   : Devin Mullins <me@twifkak.com>
+-- Stability    : stable
+-- Portability  : unportable
+--
+-- This module fixes some of the keybindings for the francophone among you who
+-- use an AZERTY keyboard layout. Config stolen from TeXitoi's config on the
+-- wiki.
+
+module XMonad.Config.Azerty (
+    -- * Usage
+    -- $usage
+    azertyConfig, azertyKeys
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Azerty
+-- >
+-- > main = xmonad azertyConfig
+--
+-- If you prefer, an azertyKeys function is provided which you can use as so:
+--
+-- > import qualified Data.Map as M
+-- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
+
+azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }
+
+azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
+    [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
+    ++
+    [((m .|. modm, k), windows $ f i)
+        | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
+          (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]

XMonad/Config/Desktop.hs

@@ -0,0 +1,179 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Desktop
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    :  unstable
+-- Portability  :  unportable
+--
+-- This module provides a config suitable for use with a desktop
+-- environment such as KDE or GNOME.
+-----------------------------------------------------------------------------
+module XMonad.Config.Desktop (
+
+    -- | Several basic integration settings are common to all of xmonad's
+    -- desktop integration configurations. The specific desktop environment
+    -- (DE) modules like "XMonad.Config.Gnome" use this module's
+    -- @desktopConfig@ to set up basic communication between xmonad and
+    -- the DE via a subset of the Extended Window Manager Hints (EWMH)
+    -- specification. Extra xmonad settings unique to specific DE's are
+    -- added by overriding or modifying @desktopConfig@ fields in the
+    -- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@.
+    --
+    -- For more information about EWMH see:
+    --
+    -- <http://standards.freedesktop.org/wm-spec/wm-spec-latest.html>
+    --
+    -- See also: "XMonad.Hooks.EwmhDesktops", "XMonad.Hooks.ManageDocks",
+    -- "XMonad.Util.EZConfig".
+
+    -- * Usage
+    -- $usage
+
+    desktopConfig,
+
+    -- * Customizing a desktop config
+    -- $customizing
+
+    -- ** Modifying layouts, manageHook, or key bindings
+    -- $layouts
+    desktopLayoutModifiers
+
+    -- ** Modifying the logHook
+    -- $logHook
+
+    -- ** Modifying the handleEventHook
+    -- $eventHook
+
+    -- ** Modifying the startupHook
+    -- $startupHook
+    ) where
+
+import XMonad
+import XMonad.Config (defaultConfig)
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.EwmhDesktops
+import XMonad.Util.Cursor
+
+import qualified Data.Map as M
+
+-- $usage
+-- While this document describes how to configure xmonad, you also need
+-- to set up your Desktop Environment (DE) and display manager to use
+-- xmonad as its window manager. For DE and distro specific tips on
+-- how to do so, see the xmonad wiki:
+--
+-- <http://haskell.org/haskellwiki/Xmonad>
+--
+-- To configure xmonad for use with a DE or with DE tools like panels
+-- and pagers, in place of @defaultConfig@ in your @~\/.xmonad/xmonad.hs@,
+-- use @desktopConfig@ or one of the other desktop configs from the
+-- @XMonad.Config@ namespace. The following setup and customization examples
+-- work the same way for the other desktop configs as for @desktopConfig@.
+-- If you are using a specific DE config, import its module instead, and
+-- use its config in place of @desktopConfig@ in the following examples.
+--
+-- > import XMonad
+-- > import XMonad.Config.Desktop
+-- >
+-- > main = xmonad desktopConfig
+--
+-- @desktopConfig@ is an 'XConfig' that configures xmonad to
+-- ignore and leave room for dock type windows like panels and trays, adds
+-- the default key binding to toggle panel visibility, and activates basic
+-- EWMH support. It also sets a prettier root window mouse pointer.
+
+-- $customizing
+-- To customize a desktop config, modify its fields as is illustrated with
+-- @defaultConfig@ in the \"Extending xmonad\" section of "XMonad.Doc.Extending".
+
+-- $layouts
+-- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
+-- To add to layouts, manageHook or key bindings use something like the following
+-- to combine your modifications with the desktop config settings:
+--
+-- > import XMonad
+-- > import XMonad.Config.Desktop
+-- > import XMonad.Layout.Tabbed
+-- > import XMonad.Util.EZConfig (additionalKeys)
+-- >
+-- > main =
+-- >   xmonad $ desktopConfig {
+-- >     -- add manage hooks while still ignoring panels and using default manageHooks
+-- >       manageHook = myManageHook <+> manageHook desktopConfig
+-- >
+-- >     -- add a fullscreen tabbed layout that does not avoid covering
+-- >     -- up desktop panels before the desktop layouts
+-- >     , layoutHook = simpleTabbed ||| layoutHook desktopConfig
+-- >     }
+-- >     -- add a screenshot key to the default desktop bindings
+-- >     `additionalKeys` [ ((mod4Mask, xK_F8), spawn "scrot") ]
+--
+-- To replace the desktop layouts with your own choices, but still
+-- allow toggling panel visibility, use 'desktopLayoutModifiers' to
+-- modify your layouts:
+--
+-- >  , layoutHook = desktopLayoutModifiers $ simpleTabbed ||| Tall 1 0.03 0.5
+--
+-- @desktopLayoutModifiers@ modifies a layout to avoid covering docks, panels,
+-- etc. that set the @_NET_WM_STRUT_PARTIAL@ property.
+-- See also "XMonad.Hooks.ManageDocks".
+
+-- $logHook
+-- To add to the logHook while still sending workspace and window information
+-- to DE apps use something like:
+--
+-- >  , logHook = myLogHook >> logHook desktopConfig
+--
+-- Or for more elaborate logHooks you can use @do@:
+--
+-- >  , logHook = do
+-- >        dynamicLogWithPP xmobarPP
+-- >        updatePointer (Relative 0.9 0.9)
+-- >        logHook desktopConfig
+--
+
+-- $eventHook
+-- To customize xmonad's event handling while still having it respond
+-- to EWMH events from pagers, task bars, etc. add to your imports:
+--
+-- > import Data.Monoid
+--
+-- and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@)
+--
+-- >  , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig)
+--
+-- or 'Data.Monoid.mconcat' (like @composeAll@)
+--
+-- >  , handleEventHook = mconcat
+-- >        [ myMouseHandler
+-- >        , myMessageHandler
+-- >        , handleEventHook desktopConfig ]
+--
+
+-- $startupHook
+-- To run the desktop startupHook, plus add further actions to be run each
+-- time xmonad starts or restarts, use '>>' to combine actions as in the
+-- logHook example, or something like:
+--
+-- >  , startupHook = do
+-- >        startupHook desktopConfig
+-- >        spawn "xmonad-restart.sh"
+-- >        adjustEventInput
+--
+
+desktopConfig = ewmh defaultConfig
+    { startupHook     = setDefaultCursor xC_left_ptr
+    , layoutHook      = desktopLayoutModifiers $ layoutHook defaultConfig
+    , manageHook      = manageHook defaultConfig <+> manageDocks
+    , keys            = \c -> desktopKeys c `M.union` keys defaultConfig c }
+
+desktopKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_b), sendMessage ToggleStruts) ]
+
+desktopLayoutModifiers layout = avoidStruts layout
+

XMonad/Config/Dons.hs

@@ -1,24 +0,0 @@
---------------------------------------------------------------------
--- |
--- Module    : XMonad.Config.Dons
--- Copyright : (c) Galois, Inc. 2007
--- License   : BSD3
---
--- Maintainer: Don Stewart <dons@galois.com>
---
--- An example, simple configuration file.
---
---------------------------------------------------------------------
-
-module XMonad.Config.Dons where
-
-import XMonad
-import XMonad.Hooks.DynamicLog
-
-donsMain :: IO ()
-donsMain = dzen $ \conf -> xmonad $ conf
-        { borderWidth        = 2
-        , terminal           = "term"
-        , normalBorderColor  = "#cccccc"
-        , focusedBorderColor = "#cd8b00" }
-

XMonad/Config/Droundy.hs

@@ -8,41 +8,42 @@
 
 module XMonad.Config.Droundy ( config, mytab ) where
 
---import Control.Monad.State ( modify )
-
 import XMonad hiding (keys, config, (|||))
 import qualified XMonad (keys)
 import XMonad.Config ( defaultConfig )
 
---import XMonad.Core ( windowset )
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M
-import System.Exit
+import System.Exit ( exitWith, ExitCode(ExitSuccess) )
 
--- % Extension-provided imports
-
-import XMonad.Layout.Tabbed
-import XMonad.Layout.Combo
-import XMonad.Layout.Mosaic
-import XMonad.Layout.Named
+import XMonad.Layout.Tabbed ( tabbed, defaultTheme,
+                              shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
+import XMonad.Layout.Combo ( combineTwo )
+import XMonad.Layout.Named ( named )
 import XMonad.Layout.LayoutCombinators
-import XMonad.Layout.Square
-import XMonad.Layout.LayoutScreens
-import XMonad.Layout.WindowNavigation
-import XMonad.Layout.NoBorders
-import XMonad.Layout.WorkspaceDir
-import XMonad.Layout.ToggleLayouts
+import XMonad.Layout.Square ( Square(Square) )
+import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
+                                        windowNavigation )
+import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,
+                                     focusUp, focusDown )
+import XMonad.Layout.NoBorders ( smartBorders )
+import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )
+import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
+import XMonad.Layout.ShowWName ( showWName )
+import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
 
-import XMonad.Prompt
-import XMonad.Prompt.Layout
-import XMonad.Prompt.Shell
+import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )
+import XMonad.Prompt.Layout ( layoutPrompt )
+import XMonad.Prompt.Shell ( shellPrompt )
 
-import XMonad.Actions.CopyWindow
-import XMonad.Actions.DynamicWorkspaces
-import XMonad.Actions.RotView
+import XMonad.Actions.CopyWindow ( kill1, copy )
+import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
+                                          selectWorkspace, renameWorkspace, removeWorkspace )
+import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
+                                Direction1D( Prev, Next) )
 
---import XMonad.Hooks.ManageDocks
---import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
+import XMonad.Hooks.EwmhDesktops ( ewmh )
 
 myXPConfig :: XPConfig
 myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
@@ -61,13 +62,13 @@ keys x = M.fromList $
     -- launching and killing programs
     [ ((modMask x .|. shiftMask, xK_c     ), kill1) -- %! Close the focused window
 
-    , ((modMask x,               xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
-    , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %!  Reset the layouts on the current workspace to default
+    , ((modMask x .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
+    , ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %!  Reset the layouts on the current workspace to default
 
     -- move focus up or down the window stack
-    , ((modMask x,               xK_Tab   ), windows W.focusDown) -- %! Move focus to the next window
-    , ((modMask x,               xK_j     ), windows W.focusDown) -- %! Move focus to the next window
-    , ((modMask x,               xK_k     ), windows W.focusUp  ) -- %! Move focus to the previous window
+    , ((modMask x,               xK_Tab   ), focusDown) -- %! Move focus to the next window
+    , ((modMask x,               xK_j     ), focusDown) -- %! Move focus to the next window
+    , ((modMask x,               xK_k     ), focusUp  ) -- %! Move focus to the previous window
 
     , ((modMask x .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window
     , ((modMask x .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window
@@ -77,14 +78,10 @@ keys x = M.fromList $
 
     -- quit, or restart
     , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
-    , ((modMask x              , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad
+    , ((modMask x              , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
 
-    , ((modMask x .|. shiftMask, xK_z     ),
-       layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))
-    , ((modMask x .|. shiftMask .|. controlMask, xK_z),
-       layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900]))
-    , ((modMask x .|. shiftMask, xK_Right), rotView True)
-    , ((modMask x .|. shiftMask, xK_Left), rotView False)
+    , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)
+    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS)
     , ((modMask x, xK_Right), sendMessage $ Go R)
     , ((modMask x, xK_Left), sendMessage $ Go L)
     , ((modMask x, xK_Up), sendMessage $ Go U)
@@ -97,10 +94,12 @@ keys x = M.fromList $
     , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)
     , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)
     , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)
- 
+
     , ((0, xK_F2  ), spawn "gnome-terminal") -- %! Launch gnome-terminal
     , ((0, xK_F3  ), shellPrompt myXPConfig) -- %! Launch program
     , ((0, xK_F11   ), spawn "ksnapshot") -- %! Take snapshot
+    , ((modMask x .|. shiftMask, xK_b     ), markBoring)
+    , ((controlMask .|. modMask x .|. shiftMask, xK_b     ), clearBoring)
     , ((modMask x .|. shiftMask, xK_x     ), changeDir myXPConfig)
     , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)
     , ((modMask x .|. shiftMask, xK_v     ), selectWorkspace myXPConfig)
@@ -109,50 +108,44 @@ keys x = M.fromList $
     , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)
     , ((modMask x, xK_l ), layoutPrompt myXPConfig)
     , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
-
--- keybindings for Mosaic:
-    , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
-    , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
-    , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
-    , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
-    , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
-    , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
-    , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
+    , ((modMask x, xK_space), sendMessage Toggle)
 
     ]
- 
+
     ++
     zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
     ++
     zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
 
-config = -- withUrgencyHook FocusUrgencyHook $
-         defaultConfig
+config = ewmh defaultConfig
          { borderWidth = 1 -- Width of the window border in pixels.
-         , XMonad.workspaces = ["1:mutt","2:iceweasel"]
-         , layoutHook = workspaceDir "~" $ windowNavigation $
-                        toggleLayouts (noBorders Full) $ -- avoidStruts $
-                        Named "tabbed" (noBorders mytab) |||
-                        Named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
-                        Named "widescreen" ((mytab *||* mytab)
+         , XMonad.workspaces = ["mutt","iceweasel"]
+         , layoutHook = showWName $ workspaceDir "~" $
+                        boringWindows $ smartBorders $ windowNavigation $
+                        maximizeVertical $ toggleLayouts Full $ avoidStruts $
+                        named "tabbed" mytab |||
+                        named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
+                        named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
+                        named "widescreen" ((mytab *||* mytab)
                                                 ****//* combineTwo Square mytab mytab) --   |||
                         --mosaic 0.25 0.5
+         , manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
          , terminal = "xterm" -- The preferred terminal program.
-         , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
+         , normalBorderColor = "#222222" -- Border color for unfocused windows.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
          , XMonad.modMask = mod1Mask
          , XMonad.keys = keys
          }
 
-mytab = tabbed CustomShrink defaultTConf
+mytab = tabbed CustomShrink defaultTheme
 
 instance Shrinker CustomShrink where
-    shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' 
-    shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' 
-    shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' 
-    shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' 
-    shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' 
-    shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s'
+    shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s'
+    shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s'
+    shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s'
+    shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s'
+    shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s'
     shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s
                  where n = length s
                        halfn = n `div` 2
@@ -161,10 +154,12 @@ instance Shrinker CustomShrink where
     shrinkIt _ s = shrinkIt shrinkText s
 
 dropFromTail :: String -> String -> Maybe String
+dropFromTail "" _ = Nothing
 dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s
                  | otherwise = Nothing
 
 dropFromHead :: String -> String -> Maybe String
+dropFromHead "" _ = Nothing
 dropFromHead h s | take (length h) s == h = Just $ drop (length h) s
                  | otherwise = Nothing
 
@@ -179,7 +174,7 @@ instance UrgencyHook FocusUrgencyHook Window where
                       s { windowset = until ((Just w ==) . W.peek)
                                       W.focusUp $ windowset s }
                   | otherwise =
-                      let t = W.tag $ W.workspace $ W.current $ windowset s
+                      let t = W.currentTag $ windowset s
                       in s { windowset = until ((Just w ==) . W.peek)
                              W.focusUp $ copyWindow w t $ windowset s }
               has _ Nothing         = False

XMonad/Config/Gnome.hs

@@ -0,0 +1,82 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Gnome
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    :  unstable
+-- Portability  :  unportable
+--
+-- This module provides a config suitable for use with the GNOME desktop
+-- environment.
+
+module XMonad.Config.Gnome (
+    -- * Usage
+    -- $usage
+    gnomeConfig,
+    gnomeRun,
+    gnomeRegister
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+import XMonad.Util.Run (safeSpawn)
+
+import qualified Data.Map as M
+
+import System.Environment (getEnvironment)
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Gnome
+-- >
+-- > main = xmonad gnomeConfig
+--
+-- For examples of how to further customize @gnomeConfig@ see "XMonad.Config.Desktop".
+
+gnomeConfig = desktopConfig
+    { terminal = "gnome-terminal"
+    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c
+    , startupHook = gnomeRegister >> startupHook desktopConfig }
+
+gnomeKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_p), gnomeRun)
+    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
+
+-- | Launch the "Run Application" dialog.  gnome-panel must be running for this
+-- to work.
+gnomeRun :: X ()
+gnomeRun = withDisplay $ \dpy -> do
+    rw <- asks theRoot
+    gnome_panel <- getAtom "_GNOME_PANEL_ACTION"
+    panel_run   <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG"
+
+    io $ allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw gnome_panel 32 panel_run 0
+        sendEvent dpy rw False structureNotifyMask e
+        sync dpy False
+
+-- | Register xmonad with gnome. 'dbus-send' must be in the $PATH with which
+-- xmonad is started.
+--
+-- This action reduces a delay on startup only only if you have configured
+-- gnome-session>=2.26: to start xmonad with a command as such:
+--
+-- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
+gnomeRegister :: MonadIO m => m ()
+gnomeRegister = io $ do
+    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
+    whenJust x $ \sessionId -> safeSpawn "dbus-send"
+            ["--session"
+            ,"--print-reply=string"
+            ,"--dest=org.gnome.SessionManager"
+            ,"/org/gnome/SessionManager"
+            ,"org.gnome.SessionManager.RegisterClient"
+            ,"string:xmonad"
+            ,"string:"++sessionId]

XMonad/Config/Kde.hs

@@ -0,0 +1,57 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Kde
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    :  unstable
+-- Portability  :  unportable
+--
+-- This module provides a config suitable for use with the KDE desktop
+-- environment.
+
+module XMonad.Config.Kde (
+    -- * Usage
+    -- $usage
+    kdeConfig,
+    kde4Config
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Kde
+-- >
+-- > main = xmonad kdeConfig
+--
+-- For KDE 4, replace 'kdeConfig' with 'kde4Config'
+--
+-- For examples of how to further customize @kdeConfig@ see "XMonad.Config.Desktop".
+
+
+kdeConfig = desktopConfig
+    { terminal = "konsole"
+    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }
+
+kde4Config = desktopConfig
+    { terminal = "konsole"
+    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }
+
+kdeKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")
+    , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
+    ]
+
+kde4Keys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm,               xK_p), spawn "krunner")
+    , ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")
+    ]

XMonad/Config/Monad.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- experimental, not expected to work
+
+{- our goal:
+config = do
+    add layout Full
+    set terminal "urxvt"
+    add keys [blah blah blah]
+-}
+
+{-
+ideas:
+    composability!
+    "only once" features like avoidStruts, ewmhDesktops
+-}
+
+module XMonad.Config.Monad where
+
+import XMonad hiding (terminal, keys)
+import qualified XMonad as X
+import Control.Monad.Writer
+import Data.Monoid
+import Data.Accessor
+import Data.Accessor.Basic hiding (set)
+
+-- Ugly!  To fix this we'll need to change the kind of XConfig.
+newtype LayoutList a = LL [Layout a] deriving Monoid
+
+type W = Dual (Endo (XConfig LayoutList))
+mkW = Dual . Endo
+
+newtype Config a = C (WriterT W IO a)
+    deriving (Functor, Monad, MonadWriter W)
+
+-- references:
+layout = fromSetGet (\x c -> c { layoutHook = x }) layoutHook
+terminal = fromSetGet (\x c -> c { X.terminal = x }) X.terminal
+keys = fromSetGet (\x c -> c { X.keys = x }) X.keys
+
+set :: Accessor (XConfig LayoutList) a -> a -> Config ()
+set r x = tell (mkW $ r ^= x)
+add r x = tell (mkW (r ^: mappend x))
+
+--
+example :: Config ()
+example = do
+    add layout $ LL [Layout $ Full] -- make this better
+    set terminal "urxvt"

XMonad/Config/Sjanssen.hs

@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module XMonad.Config.Sjanssen (sjanssenConfig) where
+module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) where
 
 import XMonad hiding (Tall(..))
 import qualified XMonad.StackSet as W
@@ -8,44 +8,60 @@ import XMonad.Layout.Tabbed
 import XMonad.Layout.HintedTile
 import XMonad.Config (defaultConfig)
 import XMonad.Layout.NoBorders
-import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.DynamicLog hiding (xmobar)
 import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
+import XMonad.Hooks.EwmhDesktops
 import XMonad.Prompt
-import XMonad.Prompt.Shell
-import XMonad.Util.Run (spawnPipe)
+import XMonad.Actions.SpawnOn
+
+import XMonad.Layout.LayoutScreens
+import XMonad.Layout.TwoPane
 
 import qualified Data.Map as M
-import System.IO (hPutStrLn)
+
+sjanssenConfigXmobar = statusBar "exec xmobar" sjanssenPP strutkey =<< sjanssenConfig
+ where
+    strutkey (XConfig {modMask = modm}) = (modm, xK_b)
 
 sjanssenConfig = do
-    xmobar <- spawnPipe "xmobar"
-    return $ defaultConfig
-        { terminal = "urxvt"
-        , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]
-        , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }
-        , modMask = mod4Mask
+    sp <- mkSpawner
+    return . ewmh $ defaultConfig
+        { terminal = "exec urxvt"
+        , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
         , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
                 [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
                 , ((modm, button2), (\w -> focus w >> windows W.swapMaster))
                 , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
-        , keys = \c -> mykeys c `M.union` keys defaultConfig c
-        , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf)
-        , manageHook = manageHook defaultConfig <+> manageDocks
+        , keys = \c -> mykeys sp c `M.union` keys defaultConfig c
+        , layoutHook  = modifiers layouts
+        , manageHook  = composeAll [className =? x --> doShift w
+                                    | (x, w) <- [ ("Firefox", "web")
+                                                , ("Ktorrent", "7")
+                                                , ("Amarokapp", "7")]]
+                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp
+                        <+> (isFullscreen --> doFullFloat)
         }
  where
-    tiled   = HintedTile 1 0.03 0.5
+    tiled     = HintedTile 1 0.03 0.5 TopLeft
+    layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
+    modifiers = smartBorders
 
-    mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
-        [((modm,               xK_p     ), shellPrompt myPromptConfig)
+    mykeys sp (XConfig {modMask = modm}) = M.fromList $
+        [((modm,               xK_p     ), shellPromptHere sp myPromptConfig)
+        ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config))
         ,((modm .|. shiftMask, xK_c     ), kill1)
         ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)
-        ,((modm .|. shiftMask, xK_0     ), windows $ \w -> foldr copy w ws)
-        ,((modm,               xK_b     ), sendMessage ToggleStruts)
+        ,((modm .|. shiftMask, xK_0     ), windows $ copyToAll)
+        ,((modm,               xK_z     ), layoutScreens 2 $ TwoPane 0.5 0.5)
+        ,((modm .|. shiftMask, xK_z     ), rescreen)
         ]
 
     myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
-    myTConf = defaultTConf { fontName = myFont }
+    myTheme = defaultTheme { fontName = myFont }
     myPromptConfig = defaultXPConfig
                         { position = Top
                         , font = myFont
+                        , showCompletionOnTab = True
+                        , historyFilter = deleteConsecutive
                         , promptBorderWidth = 0 }

XMonad/Config/Xfce.hs

@@ -0,0 +1,45 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Xfce
+-- Copyright    : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   :  none
+-- Stability    :  unstable
+-- Portability  :  unportable
+--
+-- This module provides a config suitable for use with the Xfce desktop
+-- environment.
+
+module XMonad.Config.Xfce (
+    -- * Usage
+    -- $usage
+    xfceConfig
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Xfce
+-- >
+-- > main = xmonad xfceConfig
+--
+-- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".
+
+xfceConfig = desktopConfig
+    { terminal = "Terminal"
+    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }
+
+xfceKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm,               xK_p), spawn "xfrun4")
+    , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
+    , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")
+    ]

XMonad/Doc.hs

@@ -28,7 +28,7 @@ module XMonad.Doc
     -- * Extending xmonad with the xmonad-contrib library
     -- $extending
 
-    -- * Developing xmonad: an brief code commentary
+    -- * Developing xmonad: a brief code commentary
     -- $developing
 
     ) where
@@ -56,8 +56,8 @@ is available from <http://code.haskell.org/XMonadContrib> via darcs:
 Each stable release of xmonad is accompanied by a stable release of
 the contrib library, which you should use if (and only if) you're
 using a stable release of xmonad.  You can find the most recent
-(Oct. 2007) tarball here:
-<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.5>
+tarball here:
+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib>
 
 -}
 

XMonad/Doc/Configuring.hs

@@ -49,16 +49,25 @@ if it does exist, xmonad will use whatever settings you specify.  Note
 that this file can contain arbitrary Haskell code, which means that
 you have quite a lot of flexibility in configuring xmonad.
 
-NOTE for users of previous versions (< 0.5) of xmonad: this is a major
-change in the way xmonad is configured.  Prior to version 0.5,
-configuring xmonad required editing an xmonad source file called
-Config.hs, recompiling xmonad, and then restarting.  From version 0.5
-onwards, however, all you have to do is edit xmonad.hs and restart
-with @mod-q@; xmonad does the recompiling itself.  The format of the
-configuration file has also changed; it is now simpler and much
-shorter, only requiring you to list those settings which are different
-from the defaults.
+HISTORICAL NOTE regarding upgrading from versions (< 0.5) of xmonad
+or using old documentation:
 
+xmonad-0.5 delivered a major change in the way xmonad is configured.  Prior
+to version 0.5, configuring xmonad required editing a source file called
+Config.hs, manually recompiling xmonad, and then restarting.  From
+version 0.5 onwards, however, you should NOT edit this file or manually
+compile with ghc --make.  All you have to do is edit xmonad.hs and restart
+with @mod-q@; xmonad does the recompiling itself. The format of the
+configuration file also changed with version 0.5; enabling simpler and
+much shorter xmonad.hs files that only require listing those settings which
+are different from the defaults.
+
+While the complicated template.hs (man/xmonad.hs) files listing all default
+settings are still provided for reference, once you wish to make substantial
+changes to your configuration, the template.hs style configuration is not
+recommended. It is fine to use top-level definitions to organize your
+xmonad.hs, but wherever possible it is better to leave out settings that
+simply duplicate defaults.
 -}
 
 {- $example
@@ -88,13 +97,13 @@ Overriding default settings like this (using \"record update
 syntax\"), will yield the shortest config file, as you only have to
 describe values that differ from the defaults.
 
-An alternative is to inline the entire default config file from
-xmonad, and edit values you wish to change. This is requires more
-work, but some users may find this easier. You can find the defaults
-in the "XMonad.Config" module of the core xmonad library.
-
-However, note that (unlike previous versions of xmonad) you should not
-edit Config.hs itself.
+As an alternative, you can copy the template @xmonad.hs@ file (found
+either in the @man@ directory, if you have the xmonad source, or on
+the xmonad wiki config archive at
+<http://haskell.org/haskellwiki/Xmonad/Config_archive>)
+into your @~\/.xmonad\/@ directory.  This template file contains all
+the default settings spelled out, and you should be able to simply
+change the ones you would like to change.
 
 To see what fields can be customized beyond the ones in the example
 above, the definition of the 'XMonad.Core.XConfig' data structure can
@@ -106,45 +115,37 @@ be found in "XMonad.Core".
 #Checking_whether_your_xmonad.hs_is_correct#
 
 After changing your configuration, it is a good idea to check that it
-is syntactically and type correct.  You can do this easily by loading
-your configuration file in the Haskell interpreter:
+is syntactically and type correct.  You can do this easily by using an xmonad
+flag:
 
->    $ ghci ~/.xmonad/xmonad.hs
->    GHCi, version 6.8.1: http://www.haskell.org/ghc/  :? for help
->    Loading package base ... linking ... done.
->    Ok, modules loaded: Main.
->
->    Prelude Main> :t main
->    main :: IO ()
+>    $ xmonad --recompile
+>    $
 
-Ok, looks good.
+If there is no output, your xmonad.hs has no errors.  If there are errors, they
+will be printed to the console.  Patch them up and try again.
 
 Note, however, that if you skip this step and try restarting xmonad
 with errors in your xmonad.hs, it's not the end of the world; xmonad
 will simply display a window showing the errors and continue with the
-previous configuration settings.
+previous configuration settings. (This assumes that you have the
+\'xmessage\' utility installed; you probably do.)
 
 -}
 
 {- $load
 #Loading_your_configuration#
 
-To get xmonad to use your new settings, type @mod-q@. xmonad will
+To get xmonad to use your new settings, type @mod-q@. (Remember, the
+mod key is \'alt\' by default, but you can configure it to be
+something else, such as your Windows key if you have one.) xmonad will
 attempt to compile this file, and run it.  If everything goes well,
 xmonad will seamlessly restart itself with the new settings, keeping
 all your windows, layouts, etc. intact.  (If you change anything
 related to your layouts, you may need to hit @mod-shift-space@ after
 restarting to see the changes take effect.)  If something goes wrong,
 the previous (default) settings will be used.  Note this requires that
-GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can
-still compile @xmonad.hs@ yourself:
-
->    $ cd ~/.xmonad
->    $ /path/to/ghc --make xmonad.hs
->    $ ls
->    xmonad    xmonad.hi xmonad.hs xmonad.o
-
-When you hit @mod-q@, this newly compiled xmonad will be used.
+GHC and xmonad are in the @$PATH@ in the environment from which xmonad
+is started.
 
 -}
 

XMonad/Doc/Developing.hs

@@ -8,22 +8,25 @@
 -- Stability   :  unstable
 -- Portability :  portable
 --
--- This module documents the xmonad internals. It is intended for
--- advanced users who are curious about the xmonad source code and
--- want an brief overview. This document may also be helpful for the
--- beginner\/intermediate Haskell programmer who is motivated to write
--- an xmonad extension as a way to deepen her understanding of this
--- powerful functional language; however, there is not space here to
--- go into much detail.  A more comprehensive document introducing
--- beginner\/intermediate Haskell programmers to the xmonad source is
--- planned for the xmonad users' wiki
--- (<http://haskell.org/haskellwiki/Xmonad>).
+-- This module gives a brief overview of the xmonad internals. It is
+-- intended for advanced users who are curious about the xmonad source
+-- code and want an brief overview. This document may also be helpful
+-- for the beginner\/intermediate Haskell programmer who is motivated
+-- to write an xmonad extension as a way to deepen her understanding
+-- of this powerful functional language; however, there is not space
+-- here to go into much detail.  For a more comprehensive document
+-- covering some of the same material in more depth, see the guided
+-- tour of the xmonad source on the xmonad wiki:
+-- <http://haskell.org/haskellwiki/Xmonad/Guided_tour_of_the_xmonad_source>.
 --
 -- If you write an extension module and think it may be useful for
 -- others, consider releasing it.  Coding guidelines and licensing
 -- policies are covered at the end of this document, and must be
 -- followed if you want your code to be included in the official
--- repositories.
+-- repositories.  For a basic tutorial on the nuts and bolts of
+-- developing a new extension for xmonad, see the tutorial on the
+-- wiki:
+-- <http://haskell.org/haskellwiki/Xmonad/xmonad_development_tutorial>.
 --
 -----------------------------------------------------------------------------
 
@@ -178,7 +181,7 @@ a (possibly empty) 'XMonad.StackSet.stack' of windows.
 "XMonad.StackSet" (which should usually be imported qualified, to
 avoid name clashes with Prelude functions such as 'Prelude.delete' and
 'Prelude.filter') provides many pure functions to manipulate the
-'XMonad.StackSet.StackSet'. These functions are most commonlyq used as
+'XMonad.StackSet.StackSet'. These functions are most commonly used as
 an argument to 'XMonad.Operations.windows', which takes a pure
 function to manipulate the 'XMonad.Core.WindowSet' and does all the
 needed operations to refresh the screen and save the modified
@@ -208,7 +211,7 @@ generated by layouts or the user.
 "XMonad.Core" defines a class that generalizes the concept of events,
 'XMonad.Core.Message', constrained to types with a
 'Data.Typeable.Typeable' instance definition (which can be
-automatically derived by ghc). 'XMonad.Core.Message's are wrapped
+automatically derived by GHC). 'XMonad.Core.Message's are wrapped
 within an existential type 'XMonad.Core.SomeMessage'. The
 'Data.Typeable.Typeable' constraint allows for the definition of a
 'XMonad.Core.fromMessage' function that can unwrap the message with
@@ -246,19 +249,49 @@ xmonad contributed extensions.
 * Comment every top level function (particularly exported funtions), and
   provide a type signature.
 
-* Use Haddock syntax in the comments.
+* Use Haddock syntax in the comments (see below).
 
 * Follow the coding style of the other modules.
 
-* Code should be compilable with -Wall -Werror. There should be no warnings.
+* Code should be compilable with "ghc-options: -Wall -Werror" set in the
+xmonad-contrib.cabal file. There should be no warnings.
 
 * Partial functions should be avoided: the window manager should not
-  crash, so do not call 'error' or 'undefined'.
+  crash, so never call 'error' or 'undefined'.
 
 * Tabs are /illegal/. Use 4 spaces for indenting.
 
-* Any pure function added to the core should have QuickCheck properties
-  precisely defining its behaviour.
+* Any pure function added to the core must have QuickCheck properties
+  precisely defining its behaviour. Tests for everything else are encouraged.
+
+For examples of Haddock documentation syntax, have a look at other
+extensions.  Important points are:
+
+* Every exported function (or even better, every function) should have
+  a Haddock comment explaining what it does, and providing examples.
+
+* Literal chunks of code can be written in comments using
+  \"birdtrack\" notation (a greater-than symbol at the beginning of
+  each line).  Be sure to leave a blank line before and after each
+  birdtrack-quoted section.
+
+* Link to functions by surrounding the names in single quotes, modules
+  in double quotes.
+
+* Literal quote marks and slashes should be escaped with a backslash.
+
+To generate and view the Haddock documentation for your extension, run
+
+> runhaskell Setup haddock
+
+and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.
+
+For more information, see the Haddock documentation:
+<http://www.haskell.org/haddock/doc/html/index.html>.
+
+For more information on the nuts and bolts of how to develop your own
+extension, see the tutorial on the wiki:
+<http://haskell.org/haskellwiki/Xmonad/xmonad_development_tutorial>.
 
 -}
 

XMonad/Hooks/DynamicHooks.hs

@@ -0,0 +1,122 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DynamicHooks
+-- Copyright   :  (c) Braden Shepherdson 2008
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  Braden.Shepherdson@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- One-shot and permanent ManageHooks that can be updated at runtime.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicHooks (
+  -- * Usage
+  -- $usage
+  initDynamicHooks
+  ,dynamicMasterHook
+  ,addDynamicHook
+  ,updateDynamicHook
+  ,oneShotHook
+  ) where
+
+import XMonad
+import System.IO
+
+import Data.List
+import Data.Maybe (listToMaybe)
+import Data.Monoid
+import Data.IORef
+
+-- $usage
+-- Provides two new kinds of 'ManageHooks' that can be defined at runtime.
+--
+-- * One-shot 'ManageHooks' that are deleted after they execute.
+--
+-- * Permanent 'ManageHooks' (unless you want to destroy them)
+--
+-- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!
+-- If you want them to last, you should create them as normal in your @xmonad.hs@.
+--
+-- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:
+--
+-- > dynHooksRef <- initDynamicHooks
+--
+-- and then pass this value to the other functions in this module.
+--
+-- You also need to add the base 'ManageHook':
+--
+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }
+--
+-- You must include this @dynHooksRef@ value when using the functions in this
+-- module:
+--
+-- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList
+-- >                   [((modm, xK_i), oneShotHook dynHooksRef
+-- >                    "FFlaunchHook" (className =? "firefox") (doShift "3")
+-- >                    >> spawn "firefox")
+-- >                   ,((modm, xK_u), addDynamicHook dynHooksRef
+-- >                     (className =? "example" --> doFloat))
+-- >                   ,((modm, xK_y), updatePermanentHook dynHooksRef
+-- >                     (const idHook))) ]  -- resets the permanent hook.
+--
+
+data DynamicHooks = DynamicHooks
+    { transients :: [(Query Bool, ManageHook)]
+    , permanent  :: ManageHook }
+
+
+-- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.
+initDynamicHooks :: IO (IORef DynamicHooks)
+initDynamicHooks = newIORef (DynamicHooks { transients = [],
+                                            permanent = idHook })
+
+
+-- this hook is always executed, and the IORef's contents checked.
+-- note that transient hooks are run second, therefore taking precedence
+-- over permanent ones on matters such as which workspace to shift to.
+-- doFloat and doIgnore are idempotent.
+-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
+dynamicMasterHook :: IORef DynamicHooks -> ManageHook
+dynamicMasterHook ref = return True -->
+                  (ask >>= \w -> liftX (do
+  dh <- io $ readIORef ref
+  (Endo f)  <- runQuery (permanent dh) w
+  ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)
+  let (ts',nts) = partition fst ts
+  gs <- mapM (flip runQuery w . snd . snd) ts'
+  let (Endo g) = maybe (Endo id) id $ listToMaybe gs
+  io $ writeIORef ref $ dh { transients = map snd nts }
+  return $ Endo $ f . g
+                                       ))
+
+-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
+addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()
+addDynamicHook ref m = updateDynamicHook ref (<+> m)
+
+
+-- | Modifies the permanent 'ManageHook' with an arbitrary function.
+updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()
+updateDynamicHook ref f =
+    io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }
+
+
+-- | Creates a one-shot 'ManageHook'. Note that you have to specify the two
+-- parts of the 'ManageHook' separately. Where you would usually write:
+--
+-- > className =? "example" --> doFloat
+--
+-- you must call 'oneShotHook' as
+--
+-- > oneShotHook dynHooksRef (className =? "example) doFloat
+--
+oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()
+oneShotHook ref q a =
+  io $ modifyIORef ref
+         $ \dh -> dh { transients = (q,a):(transients dh) }
+
+
+
+

XMonad/Hooks/DynamicLog.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DynamicLog
@@ -8,143 +10,265 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- DynamicLog
---
--- Log events in:
---
--- >     1 2 [3] 4 8
---
--- format. Suitable to pipe into dzen.
+-- xmonad calls the logHook with every internal state update, which is
+-- useful for (among other things) outputting status information to an
+-- external status bar program such as xmobar or dzen.  DynamicLog
+-- provides several drop-in logHooks for this purpose, as well as
+-- flexible tools for specifying your own formatting.
 --
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.DynamicLog (
     -- * Usage
-    -- $usage 
-    dynamicLog,
-    dynamicLogDzen,
-    dynamicLogXmobar,
-    dynamicLogWithPP,
-    dynamicLogXinerama,
+    -- $usage
+
+    -- * Drop-in loggers
     dzen,
+    xmobar,
+    statusBar,
+    dynamicLog,
+    dynamicLogXinerama,
 
+    -- * Build your own formatter
+    dynamicLogWithPP,
+    dynamicLogString,
+    PP(..), defaultPP,
+
+    -- * Example formatters
+    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
+
+    -- * Formatting utilities
+    wrap, pad, trim, shorten,
+    xmobarColor, xmobarStrip,
+    dzenColor, dzenEscape, dzenStrip,
+
+    -- * Internal formatting functions
     pprWindowSet,
-    pprWindowSetXinerama,
+    pprWindowSetXinerama
+
+    -- * To Do
+    -- $todo
 
-    PP(..), defaultPP, dzenPP, sjanssenPP,
-    wrap, pad, shorten,
-    xmobarColor, dzenColor, dzenEscape,
-    makeSimpleDzenConfig
   ) where
 
--- 
+--
 -- Useful imports
 --
 import XMonad
-import Data.Maybe ( isJust )
+import Control.Monad
+import Data.Char ( isSpace )
+import Data.Maybe ( isJust, catMaybes )
 import Data.List
+import qualified Data.Map as M
 import Data.Ord ( comparing )
 import qualified XMonad.StackSet as S
-import Data.Monoid
 import System.IO
+import XMonad.Util.WorkspaceCompare
 import XMonad.Util.NamedWindows
 import XMonad.Util.Run
 
--- $usage 
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Font
+import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.ManageDocks
+
+-- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- >    import XMonad
 -- >    import XMonad.Hooks.DynamicLog
--- >    main = xmonad defaultConfig { logHook = dynamicLog }
+--
+-- If you just want a quick-and-dirty status bar with zero effort, try
+-- the 'xmobar' or 'dzen' functions:
+--
+-- > main = xmonad =<< xmobar conf
+--
+-- There is also 'statusBar' if you'd like to use another status bar, or would
+-- like to use different formatting options.  The 'xmobar', 'dzen', and
+-- 'statusBar' functions are preferred over the other options listed below, as
+-- they take care of all the necessary plumbing -- no shell scripting required!
+--
+-- Alternatively, you can choose among several default status bar formats
+-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the
+-- appropriate function, for instance:
+--
+-- > main = xmonad $ defaultConfig {
+-- >    ...
+-- >    logHook = dynamicLog
+-- >    ...
+-- >  }
+--
+-- For more flexibility, you can also use 'dynamicLogWithPP' and supply
+-- your own pretty-printing format (by either defining one from scratch,
+-- or customizing one of the provided examples).
+-- For example:
+--
+-- >    -- use sjanssen's pretty-printer format, but with the sections
+-- >    -- in reverse
+-- >    logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse }
+--
+-- Note that setting the @logHook@ only sets up xmonad's output; you
+-- are responsible for starting your own status bar program (e.g. dzen
+-- or xmobar) and making sure xmonad's output is piped into it
+-- appropriately, either by putting it in your @.xsession@ or similar
+-- file, or by using @spawnPipe@ in your @main@ function, for example:
+--
+-- > import XMonad.Util.Run   -- for spawnPipe and hPutStrLn
+-- >
+-- > main = do
+-- >     h <- spawnPipe "xmobar -options -foo -bar"
+-- >     xmonad $ defaultConfig {
+-- >       ...
+-- >       logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h }
+--
+-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of
+-- your pretty-printer as in the example above; by default the status
+-- will be printed to stdout rather than the pipe you create.
+--
+-- Even if you don't use a statusbar, you can still use
+-- 'dynamicLogString' to show on-screen notifications in response to
+-- some events. For example, to show the current layout when it
+-- changes, you could make a keybinding to cycle the layout and
+-- display the current status:
+--
+-- >    , ((mod1Mask, xK_a     ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d))
+--
 
--- | An example xmonad config that spawns a new dzen toolbar and uses the default
--- dynamic log output
-makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full)))
-makeSimpleDzenConfig = do
-  h <- spawnPipe "dzen2"
-  return defaultConfig
-           { defaultGaps = [(18,0,0,0)]
-           , logHook = dynamicLogWithPP dzenPP
-                                          { ppOutput = hPutStrLn h } }
+-- $todo
+--
+--   * incorporate dynamicLogXinerama into the PP framework somehow
+--
+--   * add an xmobarEscape function
 
--- | 
+------------------------------------------------------------------------
+
+-- | Run xmonad with a dzen status bar set to some nice defaults.
 --
--- Run xmonad with a dzen status bar set to some nice defaults. Output 
--- is taken from the dynamicLogWithPP hook.
+-- > main = xmonad =<< dzen conf
 --
--- > main = dzen xmonad
+-- The intent is that the above config file should provide a nice
+-- status bar with minimal effort.
 --
--- The intent is that the above config file should provide a nice status
--- bar with minimal effort.
+-- If you wish to customize the status bar format at all, you'll have to
+-- use the 'statusBar' function instead.
 --
-dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO ()
-dzen f = do
-  h <- spawnPipe ("dzen2" ++ " " ++ flags)
-  f $ defaultConfig
-           { defaultGaps = [(15,0,0,0)] -- for fixed
-           , logHook = dynamicLogWithPP dzenPP
-                          { ppOutput = hPutStrLn h } }
+-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
+-- handle screen placement for dzen, and enables 'mod-b' for toggling
+-- the menu bar.
+--
+dzen :: LayoutClass l Window
+     => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
+dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
  where
     fg      = "'#a8a3f7'" -- n.b quoting
     bg      = "'#3f3c6d'"
-    flags   = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
+    flags   = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
+
+
+-- | Run xmonad with a xmobar status bar set to some nice defaults.
+--
+-- > main = xmonad =<< xmobar conf
+--
+-- This works pretty much the same as 'dzen' function above.
+--
+xmobar :: LayoutClass l Window
+       => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
+xmobar conf = statusBar "xmobar" xmobarPP toggleStrutsKey conf
+
+-- | Modifies the given base configuration to launch the given status bar,
+-- send status information to that bar, and allocate space on the screen edges
+-- for the bar.
+statusBar :: LayoutClass l Window
+          => String    -- ^ the command line to launch the status bar
+          -> PP        -- ^ the pretty printing options
+          -> (XConfig Layout -> (KeyMask, KeySym))
+                       -- ^ the desired key binding to toggle bar visibility
+          -> XConfig l -- ^ the base config
+          -> IO (XConfig (ModifiedLayout AvoidStruts l))
+statusBar cmd pp k conf = do
+    h <- spawnPipe cmd
+    return $ conf
+        { layoutHook = avoidStruts (layoutHook conf)
+        , logHook = do
+                        logHook conf
+                        dynamicLogWithPP pp { ppOutput = hPutStrLn h }
+        , manageHook = manageHook conf <+> manageDocks
+        , keys       = liftM2 M.union keys' (keys conf)
+        }
+ where
+    keys' = (`M.singleton` sendMessage ToggleStruts) . k
 
 -- |
--- An example log hook, print a status bar output to stdout, in the form:
+-- Helper function which provides ToggleStruts keybinding
+--
+toggleStrutsKey :: XConfig t -> (KeyMask, KeySym)
+toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b )
+
+------------------------------------------------------------------------
+
+-- | An example log hook, which prints status information to stdout in
+-- the default format:
 --
 -- > 1 2 [3] 4 7 : full : title
 --
 -- That is, the currently populated workspaces, the current
 -- workspace layout, and the title of the focused window.
 --
+-- To customize the output format, see 'dynamicLogWithPP'.
+--
 dynamicLog :: X ()
 dynamicLog = dynamicLogWithPP defaultPP
 
--- |
--- A log function that uses the 'PP' hooks to customize output.
+-- | Format the current status using the supplied pretty-printing format,
+--   and write it to stdout.
 dynamicLogWithPP :: PP -> X ()
-dynamicLogWithPP pp = do
-    spaces <- asks (workspaces . config)
-    -- layout description
-    ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current
-    -- workspace list
-    ws <- withWindowSet $ return . pprWindowSet spaces pp
-    -- window title
-    wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek
+dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp
 
-    io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $
+-- | The same as 'dynamicLogWithPP', except it simply returns the status
+--   as a formatted string without actually printing it to stdout, to
+--   allow for further processing, or use in some application other than
+--   a status bar.
+dynamicLogString :: PP -> X String
+dynamicLogString pp = do
+
+    winset <- gets windowset
+    urgents <- readUrgents
+    sort' <- ppSort pp
+
+    -- layout description
+    let ld = description . S.layout . S.workspace . S.current $ winset
+
+    -- workspace list
+    let ws = pprWindowSet sort' urgents pp winset
+
+    -- window title
+    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
+
+    -- run extra loggers, ignoring any that generate errors.
+    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
+
+    return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $
                         [ ws
                         , ppLayout pp ld
                         , ppTitle  pp wt
                         ]
+                        ++ catMaybes extras
 
--- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen
--- Requires dzen. Workspaces, xinerama, layouts and the window title are handled.
---
-dynamicLogDzen :: X ()
-dynamicLogDzen = dynamicLogWithPP dzenPP
-
-
-pprWindowSet :: [String] -> PP -> WindowSet -> String
-pprWindowSet spaces pp s =  sepBy (ppWsSep pp) $ map fmt $ sortBy cmp
-            (map S.workspace (S.current s : S.visible s) ++ S.hidden s)
-   where f Nothing Nothing   = EQ
-         f (Just _) Nothing  = LT
-         f Nothing (Just _)  = GT
-         f (Just x) (Just y) = compare x y
-
-         wsIndex = flip elemIndex spaces . S.tag
-
-         cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b)
-
-         this     = S.tag (S.workspace (S.current s))
+-- | Format the workspace information, given a workspace sorting function,
+--   a list of urgent windows, a pretty-printer format, and the current
+--   WindowSet.
+pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String
+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
+            map S.workspace (S.current s : S.visible s) ++ S.hidden s
+   where this     = S.currentTag s
          visibles = map (S.tag . S.workspace) (S.visible s)
 
          fmt w = printer pp (S.tag w)
-          where printer | S.tag w == this         = ppCurrent
-                        | S.tag w `elem` visibles = ppVisible
-                        | isJust (S.stack w)      = ppHidden
-                        | otherwise               = ppHiddenNoWindows
+          where printer | S.tag w == this                                               = ppCurrent
+                        | S.tag w `elem` visibles                                       = ppVisible
+                        | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = \ppC -> ppUrgent ppC . ppHidden ppC
+                        | isJust (S.stack w)                                            = ppHidden
+                        | otherwise                                                     = ppHiddenNoWindows
 
 -- |
 -- Workspace logger with a format designed for Xinerama:
@@ -152,8 +276,12 @@ pprWindowSet spaces pp s =  sepBy (ppWsSep pp) $ map fmt $ sortBy cmp
 -- > [1 9 3] 2 7
 --
 -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,
--- and 2 and 7 are non-visible, non-empty workspaces
+-- and 2 and 7 are non-visible, non-empty workspaces.
 --
+-- Unfortunately, at the present time, the current layout and window title
+-- are not shown, and there is no way to incorporate the xinerama
+-- workspace format shown above with 'dynamicLogWithPP'.  Hopefully this
+-- will change soon.
 dynamicLogXinerama :: X ()
 dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
 
@@ -164,23 +292,43 @@ pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
         offscreen = map S.tag . filter (isJust . S.stack)
                         . sortBy (comparing S.tag) $ S.hidden ws
 
-wrap :: String -> String -> String -> String
+-- | Wrap a string in delimiters, unless it is empty.
+wrap :: String  -- ^ left delimiter
+     -> String  -- ^ right delimiter
+     -> String  -- ^ output string
+     -> String
 wrap _ _ "" = ""
 wrap l r m  = l ++ m ++ r
 
+-- | Pad a string with a leading and trailing space.
 pad :: String -> String
 pad = wrap " " " "
 
+-- | Trim leading and trailing whitespace from a string.
+trim :: String -> String
+trim = f . f
+    where f = reverse . dropWhile isSpace
+
+-- | Limit a string to a certain length, adding "..." if truncated.
 shorten :: Int -> String -> String
 shorten n xs | length xs < n = xs
              | otherwise     = (take (n - length end) xs) ++ end
  where
     end = "..."
 
-sepBy :: String -> [String] -> String
+-- | Output a list of strings, ignoring empty ones and separating the
+--   rest with the given separator.
+sepBy :: String   -- ^ separator
+      -> [String] -- ^ fields to output
+      -> String
 sepBy sep = concat . intersperse sep . filter (not . null)
 
-dzenColor :: String -> String -> String -> String
+-- | Use dzen escape codes to output a string with given foreground
+--   and background colors.
+dzenColor :: String  -- ^ foreground color: a color name, or #rrggbb format
+          -> String  -- ^ background color
+          -> String  -- ^ output string
+          -> String
 dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)
  where (fg1,fg2) | null fg = ("","")
                  | otherwise = ("^fg(" ++ fg ++ ")","^fg()")
@@ -191,41 +339,126 @@ dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)
 dzenEscape :: String -> String
 dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
 
-xmobarColor :: String -> String -> String -> String
+-- | Strip dzen formatting or commands. Useful to remove ppHidden
+--   formatting in ppUrgent field. For example:
+--
+-- >     , ppHidden          = dzenColor "gray20" "" . wrap "(" ")"
+-- >     , ppUrgent          = dzenColor "dark orange" "" .  dzenStrip
+dzenStrip :: String -> String
+dzenStrip = strip [] where
+    strip keep x
+      | null x              = keep
+      | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)
+      | '^' == head x       = strip keep (drop 1 . dropWhile (/= ')') $ x)
+      | otherwise           = let (good,x') = span (/= '^') x
+                              in strip (keep ++ good) x'
+
+-- | Use xmobar escape codes to output a string with given foreground
+--   and background colors.
+xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
+            -> String  -- ^ background color
+            -> String  -- ^ output string
+            -> String
 xmobarColor fg bg = wrap t "</fc>"
  where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
 
--- | The 'PP' type allows the user to customize various behaviors of
--- dynamicLogPP
-data PP = PP { ppCurrent, ppVisible
-             , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String
-             , ppSep, ppWsSep :: String
+-- ??? add an xmobarEscape function?
+
+-- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent
+--   field. For example:
+--
+-- >     , ppHidden          = xmobarColor "gray20" "" . wrap "<" ">"
+-- >     , ppUrgent          = xmobarColor "dark orange" "" .  xmobarStrip
+xmobarStrip :: String -> String
+xmobarStrip = strip [] where
+    strip keep x
+      | null x                 = keep
+      | "<fc="  `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= '>') $ x)
+      | "</fc>" `isPrefixOf` x = strip keep (drop 5  x)
+      | '<' == head x          = strip (keep ++ "<") (tail x)
+      | otherwise              = let (good,x') = span (/= '<') x
+                                 in strip (keep ++ good) x'
+
+-- | The 'PP' type allows the user to customize the formatting of
+--   status information.
+data PP = PP { ppCurrent :: WorkspaceId -> String
+               -- ^ how to print the tag of the currently focused
+               -- workspace
+             , ppVisible :: WorkspaceId -> String
+               -- ^ how to print tags of visible but not focused
+               -- workspaces (xinerama only)
+             , ppHidden  :: WorkspaceId -> String
+               -- ^ how to print tags of hidden workspaces which
+               -- contain windows
+             , ppHiddenNoWindows :: WorkspaceId -> String
+               -- ^ how to print tags of empty hidden workspaces
+             , ppUrgent :: WorkspaceId -> String
+               -- ^ format to be applied to tags of urgent workspaces.
+               -- NOTE that 'ppUrgent' is applied /in addition to/
+               -- 'ppHidden'!
+             , ppSep :: String
+               -- ^ separator to use between different log sections
+               -- (window name, layout, workspaces)
+             , ppWsSep :: String
+               -- ^ separator to use between workspace tags
              , ppTitle :: String -> String
+               -- ^ window title format
              , ppLayout :: String -> String
+               -- ^ layout name format
              , ppOrder :: [String] -> [String]
+               -- ^ how to order the different log sections. By
+               --   default, this function receives a list with three
+               --   formatted strings, representing the workspaces,
+               --   the layout, and the current window title,
+               --   respectively. If you have specified any extra
+               --   loggers in 'ppExtras', their output will also be
+               --   appended to the list.  To get them in the reverse
+               --   order, you can just use @ppOrder = reverse@.  If
+               --   you don't want to display the current layout, you
+               --   could use something like @ppOrder = \\(ws:_:t:_) ->
+               --   [ws,t]@, and so on.
+             , ppSort :: X ([WindowSpace] -> [WindowSpace])
+               -- ^ how to sort the workspaces.  See
+               -- "XMonad.Util.WorkspaceCompare" for some useful
+               -- sorts.
+             , ppExtras :: [X (Maybe String)]
+               -- ^ loggers for generating extra information such as
+               -- time and date, system load, battery status, and so
+               -- on.  See "XMonad.Util.Loggers" for examples, or create
+               -- your own!
              , ppOutput :: String -> IO ()
+               -- ^ applied to the entire formatted string in order to
+               -- output it.  Can be used to specify an alternative
+               -- output method (e.g. write to a pipe instead of
+               -- stdout), and\/or to perform some last-minute
+               -- formatting.
              }
 
--- | The default pretty printing options, as seen in dynamicLog
+-- | The default pretty printing options, as seen in 'dynamicLog'.
 defaultPP :: PP
 defaultPP = PP { ppCurrent         = wrap "[" "]"
                , ppVisible         = wrap "<" ">"
                , ppHidden          = id
                , ppHiddenNoWindows = const ""
+               , ppUrgent          = id
                , ppSep             = " : "
                , ppWsSep           = " "
                , ppTitle           = shorten 80
                , ppLayout          = id
                , ppOrder           = id
                , ppOutput          = putStrLn
+               , ppSort            = getSortByIndex
+               , ppExtras          = []
                }
 
--- | Settings to emulate dwm's statusbar, dzen only
+-- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in
+-- ppUrgent.
 dzenPP :: PP
 dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
                      , ppVisible  = dzenColor "black" "#999999" . pad
                      , ppHidden   = dzenColor "black" "#cccccc" . pad
                      , ppHiddenNoWindows = const ""
+                     , ppUrgent   = dzenColor "red" "yellow" . dzenStrip
                      , ppWsSep    = ""
                      , ppSep      = ""
                      , ppLayout   = dzenColor "black" "#cccccc" .
@@ -238,17 +471,34 @@ dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
                      , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
                      }
 
--- | The options that sjanssen likes to use, as an example.  Note the use of
--- 'xmobarColor' and the record update on defaultPP
+-- | Some nice xmobar defaults.
+xmobarPP :: PP
+xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
+                     , ppTitle   = xmobarColor "green"  "" . shorten 40
+                     , ppVisible = wrap "(" ")"
+                     , ppUrgent = xmobarColor "red" "yellow"
+                     }
+
+-- | The options that sjanssen likes to use with xmobar, as an
+-- example.  Note the use of 'xmobarColor' and the record update on
+-- 'defaultPP'.
 sjanssenPP :: PP
-sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000"
-                       , ppTitle = xmobarColor "#00ee00" "" . shorten 80
+sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black"
+                       , ppTitle = xmobarColor "#00ee00" "" . shorten 120
                        }
 
--- | These are good defaults to be used with the xmobar status bar
-dynamicLogXmobar :: X ()
-dynamicLogXmobar = 
-    dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
-                               , ppTitle   = xmobarColor "green"  "" . shorten 40
-                               , ppVisible = wrap "(" ")"
-                               }
+-- | The options that byorgey likes to use with dzen, as another example.
+byorgeyPP :: PP
+byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
+                      , ppHidden  = dzenColor "black"  "#a8a3f7" . pad
+                      , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
+                      , ppUrgent  = dzenColor "red"    "yellow"
+                      , ppSep     = " | "
+                      , ppWsSep   = ""
+                      , ppTitle   = shorten 70
+                      , ppOrder   = reverse
+                      }
+  where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']
+                                       then pad wsId
+                                       else ""
+

XMonad/Hooks/EwmhDesktops.hs

@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.EwmhDesktops
--- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
+-- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>
 -- License      : BSD
 --
 -- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
@@ -9,23 +9,30 @@
 -- Portability  : unportable
 --
 -- Makes xmonad use the EWMH hints to tell panel applications about its
--- workspaces and the windows therein.
+-- workspaces and the windows therein. It also allows the user to interact
+-- with xmonad by clicking on panels and window lists.
 -----------------------------------------------------------------------------
 module XMonad.Hooks.EwmhDesktops (
     -- * Usage
     -- $usage
-    ewmhDesktopsLogHook
+    ewmh,
+    ewmhDesktopsStartup,
+    ewmhDesktopsLogHook,
+    ewmhDesktopsLogHookCustom,
+    ewmhDesktopsEventHook
     ) where
 
-import Data.List    (elemIndex, sortBy)
-import Data.Ord     (comparing)
-import Data.Maybe   (fromMaybe)
+import Codec.Binary.UTF8.String (encode)
+import Data.List
+import Data.Maybe
+import Data.Monoid
 
 import XMonad
 import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import XMonad.Util.WorkspaceCompare
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -33,27 +40,36 @@ import XMonad.Hooks.SetWMName
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > myLogHook :: X ()
--- > myLogHook = do ewmhDesktopsLogHook
--- >                return ()
--- >
--- > main = xmonad defaultConfig { logHook = myLogHook }
--- 
--- For more detailed instructions on editing the layoutHook see:
+-- > main = xmonad $ ewmh defaultConfig
 --
--- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+-- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks.
 
--- | 
+
+-- | Add EWMH functionality to the given config.  See above for an example.
+ewmh :: XConfig a -> XConfig a
+ewmh c = c { startupHook     = startupHook c +++ ewmhDesktopsStartup
+           , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook
+           , logHook         = logHook c +++ ewmhDesktopsLogHook }
+ where x +++ y = mappend x y
+
+-- |
+-- Initializes EwmhDesktops and advertises EWMH support to the X
+-- server
+ewmhDesktopsStartup :: X ()
+ewmhDesktopsStartup = setSupported
+
+-- |
 -- Notifies pagers and window lists, such as those in the gnome-panel
 -- of the current state of workspaces and windows.
 ewmhDesktopsLogHook :: X ()
-ewmhDesktopsLogHook = withWindowSet $ \s -> do
-    -- Bad hack because xmonad forgets the original order of things, it seems
-    -- see http://code.google.com/p/xmonad/issues/detail?id=53
-    let ws = sortBy (comparing W.tag) $ W.workspaces s
-    let wins = W.allWindows s
-
-    setSupported
+ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
+-- |
+-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
+-- user-specified function to transform the workspace list (post-sorting)
+ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
+ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
+    sort' <- getSortByIndex
+    let ws = f $ sort' $ W.workspaces s
 
     -- Number of Workspaces
     setNumberOfDesktops (length ws)
@@ -61,21 +77,82 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
     -- Names thereof
     setDesktopNames (map W.tag ws)
 
-    -- Current desktop
-    fromMaybe (return ()) $ do
-        n <- W.lookupWorkspace 0 s
-        i <- elemIndex n $ map W.tag ws
-        return $ setCurrentDesktop i
-
+    -- all windows, with focused windows last
+    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
     setClientList wins
 
-    -- Per window Desktop
-    forM (zip ws [(0::Int)..]) $ \(w, wn) ->
-        forM (W.integrate' (W.stack w)) $ \win -> do
-            setWindowDesktop win wn
+    -- Current desktop
+    case (elemIndex (W.currentTag s) $ map W.tag ws) of
+      Nothing -> return ()
+      Just curr -> do
+        setCurrentDesktop curr
+
+        -- Per window Desktop
+        -- To make gnome-panel accept our xinerama stuff, we display
+        -- all visible windows on the current desktop.
+        forM_ (W.current s : W.visible s) $ \x ->
+            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
+                setWindowDesktop win curr
+
+    forM_ (W.hidden s) $ \w ->
+        case elemIndex (W.tag w) (map W.tag ws) of
+          Nothing -> return ()
+          Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
+                         setWindowDesktop win wn
+
+    setActiveWindow
 
     return ()
 
+-- |
+-- Intercepts messages from pagers and similar applications and reacts on them.
+-- Currently supports:
+--
+--  * _NET_CURRENT_DESKTOP (switching desktops)
+--
+--  * _NET_WM_DESKTOP (move windows to other desktops)
+--
+--  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
+--
+ewmhDesktopsEventHook :: Event -> X All
+ewmhDesktopsEventHook e = handle e >> return (All True)
+
+handle :: Event -> X ()
+handle ClientMessageEvent {
+               ev_window = w,
+               ev_message_type = mt,
+               ev_data = d
+       } = withWindowSet $ \s -> do
+       sort' <- getSortByIndex
+       let ws = sort' $ W.workspaces s
+
+       a_cd <- getAtom "_NET_CURRENT_DESKTOP"
+       a_d <- getAtom "_NET_WM_DESKTOP"
+       a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+       a_cw <- getAtom "_NET_CLOSE_WINDOW"
+       a_ignore <- mapM getAtom ["XMONAD_TIMER"]
+       if  mt == a_cd then do
+               let n = fromIntegral (head d)
+               if 0 <= n && n < length ws then
+                       windows $ W.view (W.tag (ws !! n))
+                 else  trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n
+        else if mt == a_d then do
+               let n = fromIntegral (head d)
+               if 0 <= n && n < length ws then
+                       windows $ W.shiftWin (W.tag (ws !! n)) w
+                 else  trace $ "Bad _NET_DESKTOP with data[0]="++show n
+        else if mt == a_aw then do
+               windows $ W.focusWindow w
+        else if mt == a_cw then do
+               killWindow w
+        else if mt `elem` a_ignore then do
+           return ()
+        else do
+          -- The Message is unknown to us, but that is ok, not all are meant
+          -- to be handled by the window manager
+          return ()
+handle _ = return ()
+
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do
@@ -97,8 +174,7 @@ setDesktopNames names = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_DESKTOP_NAMES"
     c <- getAtom "UTF8_STRING"
-    let names' = map (fromIntegral.fromEnum) $
-            concatMap (("Workspace "++) . (++['\0'])) names
+    let names' = map fromIntegral $ concatMap ((++[0]) . encode) names
     io $ changeProperty8 dpy r a c propModeReplace names'
 
 setClientList :: [Window] -> X ()
@@ -122,9 +198,24 @@ setSupported = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_SUPPORTED"
     c <- getAtom "ATOM"
-    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]
+    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
+                         ,"_NET_NUMBER_OF_DESKTOPS"
+                         ,"_NET_CLIENT_LIST"
+                         ,"_NET_CLIENT_LIST_STACKING"
+                         ,"_NET_CURRENT_DESKTOP"
+                         ,"_NET_DESKTOP_NAMES"
+                         ,"_NET_ACTIVE_WINDOW"
+                         ,"_NET_WM_DESKTOP"
+                         ,"_NET_WM_STRUT"
+                         ]
     io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
 
     setWMName "xmonad"
 
-
+setActiveWindow :: X ()
+setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
+    let w = fromMaybe none (W.peek s)
+    r <- asks theRoot
+    a <- getAtom "_NET_ACTIVE_WINDOW"
+    c <- getAtom "WINDOW"
+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]

XMonad/Hooks/FadeInactive.hs

@@ -0,0 +1,94 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.FadeInactive
+-- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com>
+-- License      : BSD
+--
+-- Maintainer   : Justin Bogner <mail@justinbogner.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,
+-- which causes those windows to become slightly translucent if something
+-- like xcompmgr is running
+-----------------------------------------------------------------------------
+module XMonad.Hooks.FadeInactive (
+    -- * Usage
+    -- $usage
+    setOpacity,
+    isUnfocused,
+    fadeIn,
+    fadeOut,
+    fadeIf,
+    fadeInactiveLogHook,
+    fadeOutLogHook
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import Control.Monad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Hooks.FadeInactive
+-- >
+-- > myLogHook :: X ()
+-- > myLogHook = fadeInactiveLogHook fadeAmount
+-- >     where fadeAmount = 0.8
+-- >
+-- > main = xmonad defaultConfig { logHook = myLogHook }
+--
+-- fadeAmount can be any rational between 0 and 1.
+-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
+-- or something similar for this to do anything
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | Converts a percentage to the format required for _NET_WM_WINDOW_OPACITY
+rationalToOpacity :: Integral a => Rational -> a
+rationalToOpacity perc
+    | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability
+    | otherwise = round $ perc * 0xffffffff
+
+-- | sets the opacity of a window
+setOpacity :: Window -> Rational -> X ()
+setOpacity w t = withDisplay $ \dpy -> do
+    a <- getAtom "_NET_WM_WINDOW_OPACITY"
+    c <- getAtom "CARDINAL"
+    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
+
+-- | fades a window out by setting the opacity
+fadeOut :: Rational -> Window -> X ()
+fadeOut = flip setOpacity
+
+-- | makes a window completely opaque
+fadeIn :: Window -> X ()
+fadeIn = fadeOut 1
+
+-- | Fades a window by the specified amount if it satisfies the first query, otherwise
+-- makes it opaque.
+fadeIf :: Query Bool -> Rational -> Query Rational
+fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1
+
+-- | sets the opacity of inactive windows to the specified amount
+fadeInactiveLogHook :: Rational -> X ()
+fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused
+
+-- | returns True if the window doesn't have the focus.
+isUnfocused :: Query Bool
+isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset
+
+-- | fades out every window by the amount returned by the query.
+fadeOutLogHook :: Query Rational -> X ()
+fadeOutLogHook qry = withWindowSet $ \s -> do
+    let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
+                      concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
+    forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)

XMonad/Hooks/FloatNext.hs

@@ -0,0 +1,157 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.FloatNext
+-- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Hook and keybindings for automatically sending the next
+-- spawned window(s) to the floating layer.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.FloatNext ( -- * Usage
+                                -- $usage
+
+                                -- * The hook
+                                floatNextHook
+
+                                -- * Actions
+                              , floatNext
+                              , toggleFloatNext
+                              , floatAllNew
+                              , toggleFloatAllNew
+
+                                -- * Queries
+                              , willFloatNext
+                              , willFloatAllNew
+
+                                -- * 'DynamicLog' utilities
+                                -- $pp
+                              , willFloatNextPP
+                              , willFloatAllNewPP
+                              , runLogHook ) where
+
+import Prelude hiding (all)
+
+import XMonad
+
+import Control.Monad (join)
+import Control.Applicative ((<$>))
+import Control.Arrow (first, second)
+import Control.Concurrent.MVar
+import System.IO.Unsafe (unsafePerformIO)
+
+
+{- Helper functions -}
+
+modifyMVar2 :: MVar a -> (a -> a) -> IO ()
+modifyMVar2 v f = modifyMVar_ v (return . f)
+
+_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
+_set f b = io $ modifyMVar2 floatModeMVar (f $ const b)
+
+_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
+_toggle f = io $ modifyMVar2 floatModeMVar (f not)
+
+_get :: ((Bool, Bool) -> a) -> X a
+_get f = io $ f <$> readMVar floatModeMVar
+
+_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
+_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing
+
+
+{- The current state is kept here -}
+
+floatModeMVar :: MVar (Bool, Bool)
+floatModeMVar = unsafePerformIO $ newMVar (False, False)
+
+
+-- $usage
+-- This module provides actions (that can be set as keybindings)
+-- to automatically send the next spawned window(s) to the floating
+-- layer.
+--
+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.FloatNext
+--
+-- and adding 'floatNextHook' to your 'ManageHook':
+--
+-- > myManageHook = floatNextHook <+> manageHook defaultConfig
+--
+-- The 'floatNext' and 'toggleFloatNext' functions can be used in key
+-- bindings to float the next spawned window:
+--
+-- > , ((modm, xK_e), toggleFloatNext)
+--
+-- 'floatAllNew' and 'toggleFloatAllNew' are similar but float all
+-- spawned windows until disabled again.
+--
+-- > , ((modm, xK_r), toggleFloatAllNew)
+
+
+-- | This 'ManageHook' will selectively float windows as set
+-- by 'floatNext' and 'floatAllNew'.
+floatNextHook :: ManageHook
+floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar
+                   io $ putMVar floatModeMVar (False, all)
+                   if next || all then doFloat else idHook
+
+
+-- | @floatNext True@ arranges for the next spawned window to be
+-- sent to the floating layer, @floatNext False@ cancels it.
+floatNext :: Bool -> X ()
+floatNext = _set first
+
+toggleFloatNext :: X ()
+toggleFloatNext = _toggle first
+
+-- | @floatAllNew True@ arranges for new windows to be
+-- sent to the floating layer, @floatAllNew False@ cancels it
+floatAllNew :: Bool -> X ()
+floatAllNew = _set second
+
+toggleFloatAllNew :: X ()
+toggleFloatAllNew = _toggle second
+
+
+-- | Whether the next window will be set floating
+willFloatNext :: X Bool
+willFloatNext = _get fst
+
+-- | Whether new windows will be set floating
+willFloatAllNew :: X Bool
+willFloatAllNew = _get snd
+
+
+-- $pp
+-- The following functions are used to display the current
+-- state of 'floatNext' and 'floatAllNew' in your
+-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.
+-- 'willFloatNextPP' and 'willFloatAllNewPP' should be added
+-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your
+-- 'XMonad.Hooks.DynamicLog.PP'.
+--
+-- Use 'runLogHook' to refresh the output of your 'logHook', so
+-- that the effects of a 'floatNext'/... will be visible
+-- immediately:
+--
+-- > , ((modm, xK_e), toggleFloatNext >> runLogHook)
+--
+-- The @String -> String@ parameters to 'willFloatNextPP' and
+-- 'willFloatAllNewPP' will be applied to their output, you
+-- can use them to set the text color, etc., or you can just
+-- pass them 'id'.
+
+willFloatNextPP :: (String -> String) -> X (Maybe String)
+willFloatNextPP = _pp fst "Next"
+
+willFloatAllNewPP :: (String -> String) -> X (Maybe String)
+willFloatAllNewPP = _pp snd "All"
+
+runLogHook :: X ()
+runLogHook = join $ asks $ logHook . config

XMonad/Hooks/InsertPosition.hs

@@ -0,0 +1,74 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.InsertPosition
+-- Copyright   :  (c) 2009 Adam Vogt
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  vogt.adam@gmail.com
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- Configure where new windows should be added and which window should be
+-- focused.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.InsertPosition (
+    -- * Usage
+    -- $usage
+    insertPosition
+    ,Focus(..), Position(..)
+    ) where
+
+import XMonad(ManageHook, MonadReader(ask))
+import qualified XMonad.StackSet as W
+import Control.Applicative((<$>))
+import Data.Maybe(fromMaybe)
+import Data.List(find)
+import Data.Monoid(Endo(Endo))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.InsertPosition
+-- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook }
+--
+-- You should you put the manageHooks that use 'doShift' to take effect
+-- /before/ 'insertPosition', so that the window order will be consistent.
+-- Because ManageHooks compose from right to left (like function composition
+-- '.'), this means that 'insertPosition' should be the leftmost ManageHook.
+
+data Position = Master | End | Above | Below
+data Focus = Newer | Older
+
+-- | insertPosition. A manage hook for placing new windows. XMonad's default is
+-- the same as using: @insertPosition Above Newer@.
+insertPosition :: Position -> Focus -> ManageHook
+insertPosition pos foc = Endo . g <$> ask
+  where
+    g w = viewingWs w (updateFocus w . ins w . W.delete w)
+    ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $
+        case pos of
+            Master -> W.insertUp w . W.focusMaster
+            End    -> insertDown w . W.modify' focusLast'
+            Above  -> W.insertUp w
+            Below  -> insertDown w
+    updateFocus =
+        case foc of
+            Older -> const id
+            Newer -> W.focusWindow
+
+-- | Modify the StackSet when the workspace containing w is focused
+viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd
+viewingWs w f = do
+    i <- W.tag . W.workspace . W.current
+    ws <- find (elem w . W.integrate' . W.stack) . W.workspaces
+    maybe id (fmap (W.view i . f) . W.view . W.tag) ws
+
+-- | 'insertDown' and 'focusLast' belong in XMonad.StackSet?
+insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd
+insertDown w = W.swapDown . W.insertUp w
+
+focusLast' ::  W.Stack a -> W.Stack a
+focusLast' st = let ws = W.integrate st
+    in W.Stack (last ws) (tail $ reverse ws) []

XMonad/Hooks/ManageDocks.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
 {-# OPTIONS -fglasgow-exts #-}
--- deriving Typeable
+-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.ManageDocks
@@ -17,136 +17,243 @@
 module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
-    manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts)
+    manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    ToggleStruts(..),
+    SetStruts(..),
+    module XMonad.Util.Types,
+
+    -- for XMonad.Actions.FloatSnap
+    calcGap
     ) where
 
 
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
-import Data.Maybe (catMaybes)
+import Control.Monad
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Types
+import XMonad.Util.WindowProperties (getProp32s)
+
+import qualified Data.Set as S
+
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Hooks.ManageDocks
 --
--- The first component is a 'ManageHook' which recognizes these windows.  To
--- enable it:
+-- The first component is a 'ManageHook' which recognizes these
+-- windows and de-manages them, so that xmonad does not try to tile
+-- them.  To enable it:
 --
 -- > manageHook = ... <+> manageDocks
 --
--- The second component is a layout modifier that prevents windows from
--- overlapping these dock windows.  It is intended to replace xmonad's
--- so-called "gap" support.  First, you must add it to your list of layouts:
+-- The second component is a layout modifier that prevents windows
+-- from overlapping these dock windows.  It is intended to replace
+-- xmonad's so-called \"gap\" support.  First, you must add it to your
+-- list of layouts:
 --
 -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
+-- >                   where  tall = Tall 1 (3/100) (1/2)
 --
--- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar
--- to:
+-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
+-- similar to:
 --
--- > ,((modMask,               xK_b     ), sendMessage ToggleStruts)
+-- > ,((modm, xK_b     ), sendMessage ToggleStruts)
+--
+-- If you have multiple docks, you can toggle their gaps individually.
+-- For example, to toggle only the top gap:
+--
+-- > ,((modm .|. controlMask, xK_t), sendMessage $ ToggleStrut U)
+--
+-- Similarly, you can use 'D', 'L', and 'R' to individually toggle
+-- gaps on the bottom, left, or right.
+--
+-- If you want certain docks to be avoided but others to be covered by
+-- default, you can manually specify the sides of the screen on which
+-- docks should be avoided, using 'avoidStrutsOn'.  For example:
+--
+-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
+--
+-- /Important note/: if you are switching from manual gaps
+-- (defaultGaps in your config) to avoidStruts (recommended, since
+-- manual gaps will probably be phased out soon), be sure to switch
+-- off all your gaps (with mod-b) /before/ reloading your config with
+-- avoidStruts!  Toggling struts with a 'ToggleStruts' message will
+-- not work unless your gaps are set to zero.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 --
 
--- |
--- Detects if the given window is of type DOCK and if so, reveals it, but does
--- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
+-- | Detects if the given window is of type DOCK and if so, reveals
+--   it, but does not manage it. If the window has the STRUT property
+--   set, adjust the gap accordingly.
 manageDocks :: ManageHook
 manageDocks = checkDock --> doIgnore
 
--- |
--- Checks if a window is a DOCK window
+-- | Checks if a window is a DOCK or DESKTOP window
 checkDock :: Query Bool
 checkDock = ask >>= \w -> liftX $ do
-    a <- getAtom "_NET_WM_WINDOW_TYPE"
-    d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
-    mbr <- getProp a w
+    dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
+    desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
+    mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
     case mbr of
-        Just [r] -> return (fromIntegral r == d)
+        Just [r] -> return $ elem (fromIntegral r) [dock, desk]
         _        -> return False
 
--- |
--- Gets the STRUT config, if present, in xmonad gap order
-getStrut :: Window -> X (Maybe (Int, Int, Int, Int))
+-- | Gets the STRUT config, if present, in xmonad gap order
+getStrut :: Window -> X [Strut]
 getStrut w = do
-    a <- getAtom "_NET_WM_STRUT"
-    mbr <- getProp a w
-    case mbr of
-        Just [l,r,t,b] -> return (Just (
-                    fromIntegral t,
-                    fromIntegral b,
-                    fromIntegral l,
-                    fromIntegral r))
-        _              -> return Nothing
+    msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
+    case msp of
+        Just sp -> return $ parseStrutPartial sp
+        Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w
+ where
+    parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
+    parseStrut _ = []
 
--- |
--- Helper to read a property
-getProp :: Atom -> Window -> X (Maybe [CLong])
-getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
+    parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2]
+     = filter (\(_, n, _, _) -> n /= 0)
+        [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)]
+    parseStrutPartial _ = []
 
--- |
--- Goes through the list of windows and find the gap so that all STRUT
--- settings are satisfied.
-calcGap :: X Rectangle
-calcGap = withDisplay $ \dpy -> do
+-- | Goes through the list of windows and find the gap so that all
+--   STRUT settings are satisfied.
+calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
+calcGap ss = withDisplay $ \dpy -> do
     rootw <- asks theRoot
     -- We don't keep track of dock like windows, so we find all of them here
     (_,_,wins) <- io $ queryTree dpy rootw
-    struts <- catMaybes `fmap` mapM getStrut wins
+    struts <- (filter careAbout . concat) `fmap` mapM getStrut wins
 
     -- we grab the window attributes of the root window rather than checking
     -- the width of the screen because xlib caches this info and it tends to
     -- be incorrect after RAndR
     wa <- io $ getWindowAttributes dpy rootw
-    return $ reduceScreen (foldl max4 (0,0,0,0) struts)
-                $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
+    let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
+    return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
+  where careAbout (s,_,_,_) = s `S.member` ss
 
--- |
--- Piecewise maximum of a 4-tuple of Ints
-max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)
-max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)
+-- | Adjust layout automagically: don't cover up any docks, status
+--   bars, etc.
+avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
+avoidStruts = avoidStrutsOn [U,D,L,R]
+
+-- | Adjust layout automagically: don't cover up docks, status bars,
+--   etc. on the indicated sides of the screen.  Valid sides are U
+--   (top), D (bottom), R (right), or L (left).
+avoidStrutsOn :: LayoutClass l a =>
+                 [Direction2D]
+              -> l a
+              -> ModifiedLayout AvoidStruts l a
+avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss
+
+data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
+
+-- | Message type which can be sent to an 'AvoidStruts' layout
+--   modifier to alter its behavior.
+data ToggleStruts = ToggleStruts
+                  | ToggleStrut Direction2D
+  deriving (Read,Show,Typeable)
+
+instance Message ToggleStruts
+
+-- | SetStruts is a message constructor used to set or unset specific struts,
+-- regardless of whether or not the struts were originally set. Here are some
+-- example bindings:
+--
+-- Show all gaps:
+--
+-- >   ,((modm .|. shiftMask  ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] [])
+--
+-- Hide all gaps:
+--
+-- >   ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound])
+--
+-- Show only upper and left gaps:
+--
+-- >   ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound])
+--
+-- Hide the bottom keeping whatever the other values were:
+--
+-- >   ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D])
+data SetStruts = SetStruts { addedStruts   :: [Direction2D]
+                           , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added.
+                           }
+  deriving (Read,Show,Typeable)
+
+instance Message SetStruts
+
+instance LayoutModifier AvoidStruts a where
+    modifyLayout (AvoidStruts ss) w r = do
+        nr <- fmap ($ r) (calcGap ss)
+        runLayout w nr
+
+    pureMess (AvoidStruts ss) m
+        | Just ToggleStruts    <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
+        | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
+        | Just (SetStruts n k) <- fromMessage m
+        , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
+        , newSS /= ss = Just $ AvoidStruts newSS
+        | otherwise = Nothing
+      where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
+                        | otherwise = S.empty
+            toggleOne x xs | x `S.member` xs = S.delete x xs
+                           | otherwise   = x `S.insert` xs
+
+
+-- | (Direction, height\/width, initial pixel, final pixel).
+
+type Strut = (Direction2D, CLong, CLong, CLong)
+
+-- | (Initial x pixel, initial y pixel,
+--    final x pixel, final y pixel).
+
+type RectC = (CLong, CLong, CLong, CLong)
 
 fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral
 
--- | Given strut values and the screen rectangle, compute a reduced screen
--- rectangle.
-reduceScreen :: (Int, Int, Int, Int) -> Rectangle -> Rectangle
-reduceScreen (t, b, l, r) (Rectangle rx ry rw rh)
- = Rectangle (rx + fi l) (ry + fi t) (rw - fi r) (rh - fi b)
+-- | Invertible conversion.
 
-r2c :: Rectangle -> (Position, Position, Position, Position)
-r2c (Rectangle x y w h) = (x, y, x + fi w, y + fi h)
+r2c :: Rectangle -> RectC
+r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
 
-c2r :: (Position, Position, Position, Position) -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle x1 y1 (fi $ x2 - x1) (fi $ y2 - y1)
+-- | Invertible conversion.
 
--- | Given a bounding rectangle 's' and another rectangle 'r', compute a
--- rectangle 'r' that fits inside 's'.
-fitRect :: Rectangle -> Rectangle -> Rectangle
-fitRect s r
- = c2r (max sx1 rx1, max sy1 ry1, min sx2 rx2, min sy2 ry2)
+c2r :: RectC -> Rectangle
+c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
+
+-- TODO: Add these QuickCheck properties to the test suite, along with
+-- suitable Arbitrary instances.
+
+-- prop_r2c_c2r :: RectC -> Bool
+-- prop_r2c_c2r r = r2c (c2r r) == r
+
+-- prop_c2r_r2c :: Rectangle -> Bool
+-- prop_c2r_r2c r = c2r (r2c r) == r
+
+reduce :: RectC -> Strut -> RectC -> RectC
+reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
+    L | p (y0, y1) -> (mx x0 sx0    , y0       , x1       , y1       )
+    R | p (y0, y1) -> (x0           , y0       , mn x1 sx1, y1       )
+    U | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )
+    D | p (x0, x1) -> (x0           , y0       , x1       , mn y1 sy1)
+    _              -> (x0           , y0       , x1       , y1       )
  where
-    (sx1, sy1, sx2, sy2) = r2c s
-    (rx1, ry1, rx2, ry2) = r2c r
+    mx a b = max a (b + n)
+    mn a b = min a (b - n)
+    p r = r `overlaps` (l, h)
 
--- | Adjust layout automagically.
-avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a
-avoidStruts = AvoidStruts True
+-- | Do the two ranges overlap?
+--
+-- Precondition for every input range @(x, y)@: @x '<=' y@.
+--
+-- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@.
 
-data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show )
-
-data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)
-instance Message ToggleStruts
-
-instance LayoutClass l a => LayoutClass (AvoidStruts l) a where
-    doLayout (AvoidStruts True lo) r s =
-        do rect <- fmap (flip fitRect r) calcGap
-           (wrs,mlo') <- doLayout lo rect s
-           return (wrs, AvoidStruts True `fmap` mlo')
-    doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s
-                                             return (wrs, AvoidStruts False `fmap` mlo')
-    handleMessage (AvoidStruts b l) m
-        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l
-        | otherwise = do ml' <- handleMessage l m
-                         return (AvoidStruts b `fmap` ml')
-    description (AvoidStruts _ l) = description l
+overlaps :: Ord a => (a, a) -> (a, a) -> Bool
+(a, b) `overlaps` (x, y) =
+  inRange (a, b) x || inRange (a, b) y || inRange (x, y) a
+  where
+  inRange (i, j) k = i <= k && k <= j

XMonad/Hooks/ManageHelpers.hs

@@ -0,0 +1,222 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ManageHelpers
+-- Copyright    : (c) Lukas Mai
+-- License      : BSD
+--
+-- Maintainer   : Lukas Mai <l.mai@web.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- This module provides helper functions to be used in @manageHook@. Here's
+-- how you might use this:
+--
+-- > import XMonad.Hooks.ManageHelpers
+-- > main =
+-- >     xmonad defaultConfig{
+-- >         ...
+-- >         manageHook = composeOne [
+-- >             isKDETrayWindow -?> doIgnore,
+-- >             transience,
+-- >             isFullscreen -?> doFullFloat,
+-- >             resource =? "stalonetray" -?> doIgnore
+-- >         ],
+-- >         ...
+-- >     }
+
+module XMonad.Hooks.ManageHelpers (
+    Side(..),
+    composeOne,
+    (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
+    isInProperty,
+    isKDETrayWindow,
+    isFullscreen,
+    isDialog,
+    pid,
+    transientTo,
+    maybeToDefinite,
+    MaybeManageHook,
+    transience,
+    transience',
+    doRectFloat,
+    doFullFloat,
+    doCenterFloat,
+    doSideFloat,
+    doFloatAt,
+    doFloatDep,
+    doHideIgnore
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.WindowProperties (getProp32s)
+
+import Data.Maybe
+import Data.Monoid
+
+import System.Posix (ProcessID)
+
+-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northwest
+-- etc. @C@ stands for Center.
+data Side = SC | NC | CE | CW | SE | SW | NE | NW | C
+    deriving (Read, Show, Eq)
+
+-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe
+type MaybeManageHook = Query (Maybe (Endo WindowSet))
+-- | A grouping type, which can hold the outcome of a predicate Query.
+-- This is analogous to group types in regular expressions.
+-- TODO: create a better API for aggregating multiple Matches logically
+data Match a = Match Bool a
+
+-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
+-- a candidate returns a 'Just' value, effectively running only the first match
+-- (whereas 'composeAll' continues and executes all matching rules).
+composeOne :: [MaybeManageHook] -> ManageHook
+composeOne = foldr try idHook
+    where
+    try q z = do
+        x <- q
+        case x of
+            Just h -> return h
+            Nothing -> z
+
+infixr 0 -?>, -->>, -?>>
+
+-- | q \/=? x. if the result of q equals x, return False
+(/=?) :: Eq a => Query a -> a -> Query Bool
+q /=? x = fmap (/= x) q
+
+-- | q <==? x. if the result of q equals x, return True grouped with q
+(<==?) :: Eq a => Query a -> a -> Query (Match a)
+q <==? x = fmap (`eq` x) q
+    where
+    eq q' x' = Match (q' == x') q'
+
+-- | q <\/=? x. if the result of q notequals x, return True grouped with q
+(</=?) :: Eq a => Query a -> a -> Query (Match a)
+q </=? x = fmap (`neq` x) q
+    where
+    neq q' x' = Match (q' /= x') q'
+
+-- | A helper operator for use in 'composeOne'. It takes a condition and an action;
+-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
+-- go on and try the next rule.
+(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
+p -?> f = do
+    x <- p
+    if x then fmap Just f else return Nothing
+
+-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.
+(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
+p -->> f = do
+    Match b m <- p
+    if b then (f m) else mempty
+
+-- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
+(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
+p -?>> f = do
+    Match b m <- p
+    if b then fmap  Just (f m) else return Nothing
+
+-- | A predicate to check whether a window is a KDE system tray icon.
+isKDETrayWindow :: Query Bool
+isKDETrayWindow = ask >>= \w -> liftX $ do
+    r <- getProp32s "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" w
+    return $ case r of
+        Just [_] -> True
+        _ -> False
+
+-- | Helper to check if a window property contains certain value.
+isInProperty :: String -> String -> Query Bool
+isInProperty p v = ask >>= \w -> liftX $ do
+    va <- getAtom v
+    r <- getProp32s p w
+    return $ case r of
+        Just xs -> fromIntegral va `elem` xs
+        _ -> False
+
+-- | A predicate to check whether a window wants to fill the whole screen.
+-- See also 'doFullFloat'.
+isFullscreen :: Query Bool
+isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN"
+
+-- | A predicate to check whether a window is a dialog.
+isDialog :: Query Bool
+isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
+
+pid :: Query (Maybe ProcessID)
+pid = ask >>= \w -> liftX $ do
+    p <- getProp32s "_NET_WM_PID" w
+    return $ case p of
+        Just [x] -> Just (fromIntegral x)
+        _        -> Nothing
+
+-- | A predicate to check whether a window is Transient.
+-- It holds the result which might be the window it is transient to
+-- or it might be 'Nothing'.
+transientTo :: Query (Maybe Window)
+transientTo = do
+    w <- ask
+    d <- (liftX . asks) display
+    liftIO $ getTransientForHint d w
+
+-- | A convenience 'MaybeManageHook' that will check to see if a window
+-- is transient, and then move it to its parent.
+transience :: MaybeManageHook
+transience = transientTo </=? Nothing -?>> move
+    where
+    move mw = maybe idHook (doF . move') mw
+    move' w s = maybe s (`W.shift` s) (W.findTag w s)
+
+-- | 'transience' set to a 'ManageHook'
+transience' :: ManageHook
+transience' = maybeToDefinite transience
+
+-- | converts 'MaybeManageHook's to 'ManageHook's
+maybeToDefinite :: MaybeManageHook -> ManageHook
+maybeToDefinite = fmap (fromMaybe mempty)
+
+
+-- | Floats the new window in the given rectangle.
+doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.
+            -> ManageHook
+doRectFloat r = ask >>= \w -> doF (W.float w r)
+
+-- | Floats the window and makes it use the whole screen. Equivalent to
+-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.
+doFullFloat :: ManageHook
+doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1
+
+-- | Floats a new window using a rectangle computed as a function of
+--   the rectangle that it would have used by default.
+doFloatDep :: (W.RationalRect -> W.RationalRect) -> ManageHook
+doFloatDep move = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w)
+
+-- | Floats a new window with its original size, and its top left
+--   corner at a specific point on the screen (both coordinates should
+--   be in the range 0 to 1).
+doFloatAt :: Rational -> Rational -> ManageHook
+doFloatAt x y = doFloatDep move
+  where
+    move (W.RationalRect _ _ w h) = W.RationalRect x y w h
+
+-- | Floats a new window with its original size on the specified side of a
+-- screen
+doSideFloat :: Side -> ManageHook
+doSideFloat side = doFloatDep move
+  where
+    move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h
+      where cx =      if side `elem` [SC,C ,NC] then (1-w)/2
+                 else if side `elem` [SW,CW,NW] then 0
+                 else {- side `elem` [SE,CE,NE] -}   1-w
+            cy =      if side `elem` [CE,C ,CW] then (1-h)/2
+                 else if side `elem` [NE,NC,NW] then 0
+                 else {- side `elem` [SE,SC,SW] -}   1-h
+
+-- | Floats a new window with its original size, but centered.
+doCenterFloat :: ManageHook
+doCenterFloat = doSideFloat C
+
+-- | Hides window and ignores it.
+doHideIgnore :: ManageHook
+doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)

XMonad/Hooks/Place.hs

@@ -0,0 +1,460 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.Place
+-- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Automatic placement of floating windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.Place   ( -- * Usage
+                              -- $usage
+
+                              -- * Placement actions
+                              placeFocused
+                            , placeHook
+
+                              -- * Placement policies
+                              -- $placements
+                            , Placement
+                            , smart
+                            , simpleSmart
+                            , fixed
+                            , underMouse
+                            , inBounds
+                            , withGaps
+
+                              -- * Others
+                            , purePlaceWindow ) where
+
+
+import XMonad
+import qualified XMonad.StackSet as S
+
+import XMonad.Layout.WindowArranger
+import XMonad.Actions.FloatKeys
+
+import qualified Data.Map as M
+import Data.Ratio ((%))
+import Data.List (sortBy, minimumBy, partition)
+import Data.Maybe (maybe, fromMaybe, catMaybes)
+import Data.Monoid (Endo(..))
+import Control.Monad (guard, join)
+import Control.Monad.Trans (lift)
+
+-- $usage
+-- This module provides a 'ManageHook' that automatically places
+-- floating windows at appropriate positions on the screen, as well
+-- as an 'X' action to manually trigger repositioning.
+--
+-- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.Place
+--
+-- and adding 'placeHook' to your 'manageHook', for example:
+--
+-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart
+-- >                                              <+> manageHook defaultConfig }
+--
+-- Note that 'placeHook' should be applied after most other hooks, especially hooks
+-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from
+-- right to left, this means that 'placeHook' should be the /first/ hook in your chain.
+--
+-- You can also define a key to manually trigger repositioning with 'placeFocused' by
+-- adding the following to your keys definition:
+--
+-- > , ((modm, xK_w), placeFocused simpleSmart)
+--
+-- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies
+-- the placement policy to use (smart, under the mouse, fixed position, etc.). See
+-- 'Placement' for a list of available policies.
+
+
+
+{- Placement policies -}
+
+-- $placements
+-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'.
+--
+-- A few examples:
+--
+-- * Basic smart placement
+--
+-- > myPlacement = simpleSmart
+--
+-- * Under the mouse (pointer at the top-left corner), but constrained
+--   inside of the screen area
+--
+-- > myPlacement = inBounds (underMouse (0, 0))
+--
+-- * Smart placement with a preference for putting windows near
+-- the center of the screen, and with 16px gaps at the top and bottom
+-- of the screen where no window will be placed
+--
+-- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5))
+
+
+-- | The type of placement policies
+data Placement = Smart (Rational, Rational)
+               | Fixed (Rational, Rational)
+               | UnderMouse (Rational, Rational)
+               | Bounds (Dimension, Dimension, Dimension, Dimension) Placement
+                 deriving (Show, Read, Eq)
+
+
+-- | Try to place windows with as little overlap as possible
+smart :: (Rational, Rational) -- ^ Where the window should be placed inside
+                              -- the available area. See 'fixed'.
+      -> Placement
+smart = Smart
+
+simpleSmart :: Placement
+simpleSmart = inBounds $ smart (0,0)
+
+
+-- | Place windows at a fixed position
+fixed :: (Rational, Rational) -- ^ Where windows should go.
+                              --
+                              --     * (0,0) -> top left of the screen
+                              --
+                              --     * (1,0) -> top right of the screen
+                              --
+                              --     * etc
+      -> Placement
+fixed = Fixed
+
+
+-- | Place windows under the mouse
+underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to
+                                   -- the window's frame; see 'fixed'.
+           -> Placement
+underMouse = UnderMouse
+
+
+-- | Apply the given placement policy, constraining the
+-- placed windows inside the screen boundaries.
+inBounds :: Placement -> Placement
+inBounds = Bounds (0,0,0,0)
+
+
+-- | Same as 'inBounds', but allows specifying gaps along the screen's edges
+withGaps :: (Dimension, Dimension, Dimension, Dimension)
+         -- ^ top, right, bottom and left gaps
+         -> Placement -> Placement
+withGaps = Bounds
+
+
+
+{- Placement functions -}
+
+
+-- | Repositions the focused window according to a placement policy. Works for
+-- both \"real\" floating windows and windows in a 'WindowArranger'-based
+-- layout.
+placeFocused :: Placement -> X ()
+placeFocused p = withFocused $ \window -> do
+                   info <- gets $ screenInfo . S.current . windowset
+                   floats <- gets $ M.keys . S.floating . windowset
+
+                   r'@(Rectangle x' y' _ _) <- placeWindow p window info floats
+
+                     -- use X.A.FloatKeys if the window is floating, send
+                     -- a WindowArranger message otherwise.
+                   case elem window floats of
+                     True -> keysMoveWindowTo (x', y') (0, 0) window
+                     False -> sendMessage $ SetGeometry r'
+
+
+-- | Hook to automatically place windows when they are created.
+placeHook :: Placement -> ManageHook
+placeHook p = do window <- ask
+                 r <- Query $ lift $ getWindowRectangle window
+                 allRs <- Query $ lift $ getAllRectangles
+                 pointer <- Query $ lift $ getPointer window
+
+                 return $ Endo $ \theWS -> fromMaybe theWS $
+                   do let currentRect = screenRect $ S.screenDetail $ S.current theWS
+                          floats = M.keys $ S.floating theWS
+
+                      guard(window `elem` floats )
+
+                        -- Look for the workspace(s) on which the window is to be
+                        -- spawned. Each of them also needs an associated screen
+                        -- rectangle; for hidden workspaces, we use the current
+                        -- workspace's screen.
+                      let infos = filter ((window `elem`) . stackContents . S.stack . fst)
+                                     $ [screenInfo $ S.current theWS]
+                                        ++ (map screenInfo $ S.visible theWS)
+                                        ++ zip (S.hidden theWS) (repeat currentRect)
+
+                      guard(not $ null infos)
+
+                      let (workspace, screen) = head infos
+                          rs = catMaybes $ map (flip M.lookup allRs)
+                               $ organizeClients workspace window floats
+                          r' = purePlaceWindow p screen rs pointer r
+                          newRect = r2rr screen r'
+                          newFloats = M.insert window newRect (S.floating theWS)
+
+                      return $ theWS { S.floating = newFloats }
+
+
+placeWindow :: Placement -> Window
+            -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)
+                 -- ^ The workspace with reference to which the window should be placed,
+                 -- and the screen's geometry.
+            -> [Window]
+                 -- ^ The list of floating windows.
+            -> X Rectangle
+placeWindow p window (ws, s) floats
+  = do (r, rs, pointer) <- getNecessaryData window ws floats
+       return $ purePlaceWindow p s rs pointer r
+
+
+-- | Compute the new position of a window according to a placement policy.
+purePlaceWindow :: Placement -- ^ The placement strategy
+                -> Rectangle -- ^ The screen
+                -> [Rectangle] -- ^ The other visible windows
+                -> (Position, Position) -- ^ The pointer's position.
+                -> Rectangle -- ^ The window to be placed
+                -> Rectangle
+purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w
+  = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b))
+    in checkBounds s' $ purePlaceWindow p' s' rs p w
+
+purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w
+
+purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h)
+  = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h
+
+purePlaceWindow (Smart ratios) s rs _ w
+  = placeSmart ratios s rs (rect_width w) (rect_height w)
+
+
+-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals
+-- inside another,
+placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle
+placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2)
+  = Rectangle (scale rx x1 (x1 + fi w1 - fi w2))
+              (scale ry y1 (y1 + fi h1 - fi h2))
+              w2 h2
+
+
+-- | Helper: Ensures its second parameter is contained inside the first
+-- by possibly moving it.
+checkBounds :: Rectangle -> Rectangle -> Rectangle
+checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2)
+  = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2))
+              (max y1 (min (y1 + fi h1 - fi h2) y2))
+              w2 h2
+
+
+
+
+
+{- Utilities -}
+
+scale :: (RealFrac a, Integral b) => a -> b -> b -> b
+scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+r2rr :: Rectangle -> Rectangle -> S.RationalRect
+r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)
+  = S.RationalRect ((fi x-fi x0) % fi w0)
+                   ((fi y-fi y0) % fi h0)
+                   (fi w % fi w0)
+                   (fi h % fi h0)
+
+
+
+{- Querying stuff -}
+
+stackContents :: Maybe (S.Stack w) -> [w]
+stackContents = maybe [] S.integrate
+
+screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
+screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)
+
+getWindowRectangle :: Window -> X Rectangle
+getWindowRectangle window
+  = do d <- asks display
+       (_, x, y, w, h, _, _) <- io $ getGeometry d window
+
+         -- We can't use the border width returned by
+         -- getGeometry because it will be 0 if the
+         -- window isn't mapped yet.
+       b <- asks $ borderWidth . config
+
+       return $ Rectangle x y (w + 2*b) (h + 2*b)
+
+getAllRectangles :: X (M.Map Window Rectangle)
+getAllRectangles = do ws <- gets windowset
+                      let allWindows = join $ map (stackContents . S.stack)
+                                         $ (S.workspace . S.current) ws
+                                         : (map S.workspace . S.visible) ws
+                                         ++ S.hidden ws
+                      allRects <- mapM getWindowRectangle allWindows
+
+                      return $ M.fromList $ zip allWindows allRects
+
+organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window]
+organizeClients ws w floats
+  = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w)
+                              $ stackContents $ S.stack ws
+    in reverse layoutCs ++ reverse floatCs
+      -- About the ordering: the smart algorithm will overlap windows
+      -- starting ith the head of the list. So:
+      --  - we put the non-floating windows first since they'll
+      --    probably be below the floating ones,
+      --  - we reverse the lists, since the newer/more important
+      --    windows are usually near the head.
+
+getPointer :: Window -> X (Position, Position)
+getPointer window = do d <- asks display
+                       (_,_,_,x,y,_,_,_) <- io $ queryPointer d window
+                       return (fi x,fi y)
+
+-- | Return values are, in order: window's rectangle,
+-- other windows' rectangles and pointer's coordinates.
+getNecessaryData :: Window
+                 -> S.Workspace WorkspaceId (Layout Window) Window
+                 -> [Window]
+                 -> X (Rectangle, [Rectangle], (Position, Position))
+getNecessaryData window ws floats
+  = do r <- getWindowRectangle window
+
+       rs <- return (organizeClients ws window floats)
+             >>= mapM getWindowRectangle
+
+       pointer <- getPointer window
+
+       return (r, rs, pointer)
+
+
+
+
+{- Smart placement algorithm -}
+
+-- | Alternate representation for rectangles.
+data SmartRectangle a = SR
+  { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive
+  , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive
+  } deriving (Show, Eq)
+
+r2sr :: Rectangle -> SmartRectangle Position
+r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h)
+
+sr2r :: SmartRectangle Position -> Rectangle
+sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0)
+
+width :: Num a => SmartRectangle a -> a
+width r = sr_x1 r - sr_x0 r
+
+height :: Num a => SmartRectangle a -> a
+height r = sr_y1 r - sr_y0 r
+
+isEmpty :: Real a => SmartRectangle a -> Bool
+isEmpty r = (width r <= 0) || (height r <= 0)
+
+contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool
+contains r1 r2 = sr_x0 r1 <= sr_x0 r2
+                 && sr_y0 r1 <= sr_y0 r2
+                 && sr_x1 r1 >= sr_x1 r2
+                 && sr_y1 r1 >= sr_y1 r2
+
+
+-- | Main placement function
+placeSmart :: (Rational, Rational) -- ^ point of the screen where windows
+                                   -- should be placed first, if possible.
+           -> Rectangle -- ^ screen
+           -> [Rectangle] -- ^ other clients
+           -> Dimension -- ^ width
+           -> Dimension -- ^ height
+           -> Rectangle
+placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h
+  = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h)
+    in position free (scale rx sx (sx + fi sw - fi w))
+                     (scale ry sy (sy + fi sh - fi h))
+                     w h
+
+-- | Second part of the algorithm:
+-- Chooses the best position in which to place a window,
+-- according to a list of free areas and an ideal position for
+-- the top-left corner.
+-- We can't use semi-open surfaces for this, so we go back to
+-- X11 Rectangles/Positions/etc instead.
+position :: [Rectangle] -- ^ Free areas
+         -> Position -> Position -- ^ Ideal coordinates
+         -> Dimension -> Dimension -- ^ Width and height of the window
+         -> Rectangle
+position rs x y w h = minimumBy distanceOrder $ map closest rs
+  where distanceOrder r1 r2
+          = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension)
+                    (distance (rect_x r2,rect_y r2) (x,y) :: Dimension)
+        distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double)
+                                   $ fi $ (x1 - x2)^(2::Int)
+                                        + (y1 - y2)^(2::Int)
+        closest r = checkBounds r (Rectangle x y w h)
+
+
+-- | First part of the algorithm:
+-- Tries to find an area in which to place a new
+-- rectangle so that it overlaps as little as possible with
+-- other rectangles already present. The first rectangles in
+-- the list will be overlapped first.
+findSpace :: Real a =>
+             SmartRectangle a -- ^ The total available area
+          -> [SmartRectangle a] -- ^ The parts already in use
+          -> a -- ^ Width of the rectangle to place
+          -> a -- ^ Height of the rectangle to place
+          -> [SmartRectangle a]
+findSpace total [] _ _ = [total]
+findSpace total rs@(_:rs') w h
+  = case filter largeEnough $ cleanup $ subtractRects total rs of
+      [] -> findSpace total rs' w h
+      as -> as
+    where largeEnough r = width r >= w && height r >= h
+
+
+-- | Subtracts smaller rectangles from a total rectangle
+-- , returning a list of remaining rectangular areas.
+subtractRects :: Real a => SmartRectangle a
+               -> [SmartRectangle a] -> [SmartRectangle a]
+subtractRects total [] = [total]
+subtractRects total (r:rs)
+  = do total' <- subtractRects total rs
+       filter (not . isEmpty)
+                [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above
+                , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right
+                , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below
+                , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left
+                ]
+
+
+-- | "Nubs" a list of rectangles, dropping all those that are
+-- already contained in another rectangle of the list.
+cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a]
+cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs
+
+sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering
+sizeOrder r1 r2 | w1 < w2 = LT
+                | w1 == w2 && h1 < h2 = LT
+                | w1 == w2 && h1 == h2 = EQ
+                | otherwise = GT
+                where w1 = width r1
+                      w2 = width r2
+                      h1 = height r1
+                      h2 = height r2
+
+dropIfContained :: Real a => SmartRectangle a
+                -> [SmartRectangle a] -> [SmartRectangle a]
+dropIfContained r rs  = if any (`contains` r) rs
+                        then rs
+                        else r:rs

XMonad/Hooks/RestoreMinimized.hs

@@ -0,0 +1,49 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.RestoreMinimized
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Lets you restore minimized windows (see "XMonad.Layout.Minimize")
+-- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
+-- and WM_CHANGE_STATE).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.RestoreMinimized
+    ( -- * Usage
+      -- $usage
+      RestoreMinimized (..)
+    , restoreMinimizedEventHook
+    ) where
+
+import Data.Monoid
+import Control.Monad(when)
+
+import XMonad
+import XMonad.Layout.Minimize
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.RestoreMinimized
+-- >
+-- > myHandleEventHook = restoreMinimizedEventHook
+-- >
+-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook }
+
+data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
+
+restoreMinimizedEventHook :: Event -> X All
+restoreMinimizedEventHook (ClientMessageEvent {ev_window = w,
+                                                ev_message_type = mt}) = do
+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+    a_cs <- getAtom "WM_CHANGE_STATE"
+    when (mt == a_aw || mt == a_cs) $ do
+        sendMessage (RestoreMinimizedWin w)
+    return (All True)
+restoreMinimizedEventHook _ = return (All True)

XMonad/Hooks/Script.hs

@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Hooks.Script
+-- Copyright   : (c) Trevor Elliott <trevor@galois.com>
+-- License     : BSD3-style (see LICENSE)
+--
+-- Maintainer  : Trevor Elliott <trevor@galois.com>
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Provides a simple interface for running a ~\/.xmonad\/hooks script with the
+-- name of a hook.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.Script (
+    -- * Usage
+    -- $usage
+
+    -- * Script Hook Interface
+    execScriptHook
+  ) where
+
+--
+-- Useful Imports
+--
+import XMonad
+
+import Control.Monad.Trans
+import System.Directory
+
+-- $usage
+--
+-- This module allows you to run a centrally located script with the text
+-- name of a hook.  The script is assumed to be located at @~\/.xmonad\/hooks@.
+--
+-- For example, if you wanted to run the hook "startup" in your script every
+-- time your startup hook ran, you could modify your xmonad config as such:
+--
+-- > main = xmonad $ defaultConfig {
+-- >   ...
+-- >   startupHook = execScriptHook "startup"
+-- >   ...
+-- >   }
+--
+-- Now, every time the startup hook runs, the command
+-- @~\/.xmonad\/hooks startup@ will also.
+
+-- | Execute a named script hook
+execScriptHook :: MonadIO m => String -> m ()
+execScriptHook hook = io $ do
+  home <- getHomeDirectory
+  let script = home ++ "/.xmonad/hooks "
+  spawn (script ++ hook)

XMonad/Hooks/ServerMode.hs

@@ -0,0 +1,106 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ServerMode
+-- Copyright   :  (c) Andrea Rossato and David Roundy 2007
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This is an 'EventHook' that will receive commands from an external
+-- client.
+--
+-- This is the example of a client:
+--
+-- > import Graphics.X11.Xlib
+-- > import Graphics.X11.Xlib.Extras
+-- > import System.Environment
+-- > import Data.Char
+-- >
+-- > usage :: String -> String
+-- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad"
+-- >
+-- > main :: IO ()
+-- > main = do
+-- >   args <- getArgs
+-- >   pn <- getProgName
+-- >   let com = case args of
+-- >               [] -> error $ usage pn
+-- >               w -> (w !! 0)
+-- >   sendCommand com
+-- >
+-- > sendCommand :: String -> IO ()
+-- > sendCommand s = do
+-- >   d   <- openDisplay ""
+-- >   rw  <- rootWindow d $ defaultScreen d
+-- >   a <- internAtom d "XMONAD_COMMAND" False
+-- >   allocaXEvent $ \e -> do
+-- >                   setEventType e clientMessage
+-- >                   setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime
+-- >                   sendEvent d rw False structureNotifyMask e
+-- >                   sync d False
+--
+-- compile with: @ghc --make sendCommand.hs@
+--
+-- run with
+--
+-- > sendCommand command number
+--
+-- For instance:
+--
+-- > sendCommand 0
+--
+--  will ask to xmonad to print the list of command numbers in
+-- stderr (so you can read it in @~\/.xsession-errors@).
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ServerMode
+    ( -- * Usage
+      -- $usage
+      ServerMode (..)
+    , serverModeEventHook
+    , serverModeEventHook'
+    ) where
+
+import Control.Monad (when)
+import Data.List
+import Data.Monoid
+import System.IO
+
+import XMonad
+import XMonad.Actions.Commands
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.ServerMode
+-- > import XMonad.Actions.Commands
+--
+-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
+--
+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
+--
+
+data ServerMode = ServerMode deriving ( Show, Read )
+
+-- | Executes a command of the list when receiving its index via a special ClientMessageEvent
+-- (indexing starts at 1)
+serverModeEventHook :: Event -> X All
+serverModeEventHook = serverModeEventHook' defaultCommands
+
+-- | serverModeEventHook' additionally takes an action to generate the list of
+-- commands.
+serverModeEventHook' :: X [(String,X ())] -> Event -> X All
+serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+        d <- asks display
+        a <- io $ internAtom d "XMONAD_COMMAND" False
+        when (mt == a && dt /= []) $ do
+             cl <- cmdAction
+             let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
+             case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
+                  Just (_,action) -> action
+                  Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+        return (All True)
+serverModeEventHook' _ _ = return (All True)

XMonad/Hooks/SetWMName.hs

@@ -14,16 +14,16 @@
 -- May be useful for making Java GUI programs work, just set WM name to "LG3D"
 -- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.
 --
--- Remember that you need to call the setWMName action yourself (at least until
--- we have startup hooks). E.g., you can bind it in your Config.hs:
+-- To your @~\/.xmonad\/xmonad.hs@ file, add the following line:
 --
--- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
+-- > import XMonad.Hooks.SetWMName
 --
--- and press the key combination before running the Java programs (you only
--- need to do it once per XMonad execution)
+-- Then edit your @startupHook@:
+--
+-- > startupHook = setWMName "LG3D"
 --
 -- For details on the problems with running Java GUI programs in non-reparenting
--- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and
+-- WMs, see <http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=6429775> and
 -- related bugs.
 --
 -- Setting WM name to "compiz" does not solve the problem, because of yet
@@ -31,8 +31,8 @@
 -- set to 0, while for other WMs the insets are \"guessed\" and the algorithm
 -- fails miserably by guessing absolutely bogus values.
 --
--- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- For detailed instructions on editing your hooks, see
+-- "XMonad.Doc.Extending#4".
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.SetWMName (

XMonad/Hooks/UrgencyHook.hs

@@ -19,40 +19,82 @@
 module XMonad.Hooks.UrgencyHook (
                                  -- * Usage
                                  -- $usage
-                                 withUrgencyHook,
-                                 focusUrgent,
+
+                                 -- ** Pop up a temporary dzen
+                                 -- $temporary
+
+                                 -- ** Highlight in existing dzen
+                                 -- $existing
+
+                                 -- ** Useful keybinding
+                                 -- $keybinding
+
+                                 -- ** Note
+                                 -- $note
+
+                                 -- * Troubleshooting
+                                 -- $troubleshooting
+
+                                 -- * Example: Setting up irssi + rxvt-unicode
+                                 -- $example
+
+                                 -- ** Configuring irssi
+                                 -- $irssi
+
+                                 -- ** Configuring screen
+                                 -- $screen
+
+                                 -- ** Configuring rxvt-unicode
+                                 -- $urxvt
+
+                                 -- ** Configuring xmonad
+                                 -- $xmonad
+
+                                 -- * Stuff for your config file:
+                                 withUrgencyHook, withUrgencyHookC,
+                                 UrgencyConfig(..), urgencyConfig,
+                                 SuppressWhen(..), RemindWhen(..),
+                                 focusUrgent, clearUrgents,
+                                 dzenUrgencyHook,
+                                 DzenUrgencyHook(..),
+                                 NoUrgencyHook(..),
+                                 FocusHook(..),
+                                 minutes, seconds,
+                                 -- * Stuff for developers:
                                  readUrgents, withUrgents,
-                                 urgencyLayoutHook,
-                                 NoUrgencyHook(..), StdoutUrgencyHook(..),
-                                 dzenUrgencyHook, DzenUrgencyHook(..),
-                                 UrgencyHook(urgencyHook),
-                                 seconds
+                                 StdoutUrgencyHook(..),
+                                 SpawnUrgencyHook(..),
+                                 UrgencyHook(urgencyHook)
                                  ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import XMonad.Layout.LayoutModifier hiding (hook)
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
 import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 
+import Control.Applicative ((<$>))
 import Control.Monad (when)
-import Data.Bits (testBit, clearBit)
+import Data.Bits (testBit)
 import Data.IORef
-import Data.List ((\\), delete)
-import Data.Maybe (listToMaybe)
+import Data.List (delete)
+import Data.Maybe (listToMaybe, maybeToList)
 import qualified Data.Set as S
 import Foreign (unsafePerformIO)
 
 -- $usage
+--
 -- To wire this up, first add:
 --
 -- > import XMonad.Hooks.UrgencyHook
 --
--- to your import list in your config file. Now, choose an urgency hook. If
--- you're just interested in displaying the urgency state in your custom
--- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided
--- 'dzenUrgencyHook', or write your own.
+-- to your import list in your config file. Now, you have a decision to make:
+-- When a window deems itself urgent, do you want to pop up a temporary dzen
+-- bar telling you so, or do you have an existing dzen wherein you would like to
+-- highlight urgent workspaces?
+
+-- $temporary
 --
 -- Enable your urgency hook by wrapping your config record in a call to
 -- 'withUrgencyHook'. For example:
@@ -60,32 +102,166 @@ import Foreign (unsafePerformIO)
 -- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
 -- >               $ defaultConfig
 --
--- If you want to modify your logHook to print out information about urgent windows,
--- the functions 'readUrgents' and 'withUrgents' are there to help you with that.
--- No example for you.
+-- This will pop up a dzen bar for five seconds telling you you've got an
+-- urgent window.
 
--- | This is the preferred method of enabling an urgency hook. It will prepend
--- an action to your logHook that removes visible windows from the list of urgent
--- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead.
-withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) =>
-                   h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l)
-withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf
-                                 , logHook = removeVisiblesFromUrgents >> logHook conf
-                                 }
+-- $existing
+--
+-- In order for xmonad to track urgent windows, you must install an urgency hook.
+-- You can use the above 'dzenUrgencyHook', or if you're not interested in the
+-- extra popup, install NoUrgencyHook, as so:
+--
+-- > main = xmonad $ withUrgencyHook NoUrgencyHook
+-- >               $ defaultConfig
+--
+-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent
+-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,
+-- then you should be good. Otherwise, you want to figure out how to set
+-- 'ppUrgent'.
 
--- | The logHook action used by 'withUrgencyHook'.
-removeVisiblesFromUrgents :: X ()
-removeVisiblesFromUrgents = do
-    visibles <- gets mapped
-    adjustUrgents (\\ (S.toList visibles))
+-- $keybinding
+--
+-- You can set up a keybinding to jump to the window that was recently marked
+-- urgent. See an example at 'focusUrgent'.
+
+-- $note
+-- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your
+-- urgency hook and restart xmonad, you may need to rejigger your layout by
+-- hitting mod-shift-space.
+
+-- $troubleshooting
+--
+-- There are three steps to get right:
+--
+-- 1. The X client must set the UrgencyHint flag. How to configure this
+--    depends on the application. If you're using a terminal app, this is in
+--    two parts:
+--
+--      * The console app must send a ^G (bell). In bash, a helpful trick is
+--        @sleep 1; echo -e \'\\a\'@.
+--
+--      * The terminal must convert the bell into UrgencyHint.
+--
+-- 2. XMonad must be configured to notice UrgencyHints. If you've added
+--    withUrgencyHook, you may need to hit mod-shift-space to reset the layout.
+--
+-- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it
+--    supports all of the arguments you told DzenUrgencyHook to pass it. Also,
+--    set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test
+--    if that works.
+--
+-- As best you can, try to isolate which one(s) of those is failing.
+
+-- $example
+--
+-- This is a commonly asked example. By default, the window doesn't get flagged
+-- urgent when somebody messages you in irssi. You will have to configure some
+-- things. If you're using different tools than this, your mileage will almost
+-- certainly vary. (For example, in Xchat2, it's just a simple checkbox.)
+
+-- $irssi
+-- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@.
+-- However, on all console applications is bestown the greatest of all notification
+-- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your
+-- friend, the bell. To configure @irssi@ to send a bell when you receive a message:
+--
+-- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT
+--
+-- Consult your local @irssi@ documentation for more detail.
+
+-- $screen
+-- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros
+-- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console
+-- applications -- in particular, to turn bell characters into evil, smelly
+-- \"visual bells.\" To turn this off, add:
+--
+-- > vbell off # or remove the existing 'vbell on' line
+--
+-- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an
+-- immediate but temporary fix.
+
+-- $urxvt
+-- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell
+-- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have
+-- an urxvt version 8.3 or newer, and second, set the following in your
+-- @.Xdefaults@:
+--
+-- > urxvt.urgentOnBell: true
+--
+-- Depending on your setup, you may need to @xrdb@ that.
+
+-- $xmonad
+-- Hopefully you already read the section on how to configure xmonad. If not,
+-- hopefully you know where to find it.
+
+-- | This is the method to enable an urgency hook. It uses the default
+-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'
+-- instead.
+withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
+                   h -> XConfig l -> XConfig l
+withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
+
+-- | This lets you modify the defaults set in 'urgencyConfig'. An example:
+--
+-- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }
+--
+-- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.
+withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
+                    h -> UrgencyConfig -> XConfig l -> XConfig l
+withUrgencyHookC hook urgConf conf = conf {
+        handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,
+        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
+    }
+
+-- | Global configuration, applied to all types of 'UrgencyHook'. See
+-- 'urgencyConfig' for the defaults.
+data UrgencyConfig = UrgencyConfig
+    { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook
+    , remindWhen   :: RemindWhen   -- ^ when to re-trigger the urgency hook
+    } deriving (Read, Show)
+
+-- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window.
+-- The default is 'Visible'. Prefix each of the following with \"don't bug me when\":
+data SuppressWhen = Visible  -- ^ the window is currently visible
+                  | OnScreen -- ^ the window is on the currently focused physical screen
+                  | Focused  -- ^ the window is currently focused
+                  | Never    -- ^ ... aww, heck, go ahead and bug me, just in case.
+                  deriving (Read, Show)
+
+-- | A set of choices as to when you want to be re-notified of an urgent
+-- window. Perhaps you focused on something and you miss the dzen popup bar. Or
+-- you're AFK. Or you feel the need to be more distracted. I don't care.
+--
+-- The interval arguments are in seconds. See the 'minutes' helper.
+data RemindWhen = Dont                    -- ^ triggering once is enough
+                | Repeatedly Int Interval -- ^ repeat <arg1> times every <arg2> seconds
+                | Every Interval          -- ^ repeat every <arg1> until the urgency hint is cleared
+                deriving (Read, Show)
+
+-- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@.
+minutes :: Rational -> Rational
+minutes secs = secs * 60
+
+-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.
+-- Use a variation of this in your config just as you use a variation of
+-- defaultConfig for your xmonad definition.
+urgencyConfig :: UrgencyConfig
+urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
 
 -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
 -- Example keybinding:
 --
--- > , ((modMask              , xK_BackSpace), focusUrgent)
+-- > , ((modm              , xK_BackSpace), focusUrgent)
 focusUrgent :: X ()
 focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe
 
+-- | Just makes the urgents go away.
+-- Example keybinding:
+--
+-- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
+clearUrgents :: X ()
+clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
+
 -- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
 -- 'readUrgents' or 'withUrgents' instead.
 {-# NOINLINE urgents #-}
@@ -103,85 +279,160 @@ readUrgents = io $ readIORef urgents
 withUrgents :: ([Window] -> X a) -> X a
 withUrgents f = readUrgents >>= f
 
-data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)
+adjustUrgents :: ([Window] -> [Window]) -> X ()
+adjustUrgents f = io $ modifyIORef urgents f
+
+type Interval = Rational
+
+-- | An urgency reminder, as reified for 'RemindWhen'.
+-- The last value is the countdown number, for 'Repeatedly'.
+data Reminder = Reminder { timer     :: TimerId
+                         , window    :: Window
+                         , interval  :: Interval
+                         , remaining :: Maybe Int
+                         } deriving Eq
+
+-- | Stores the list of urgency reminders.
+{-# NOINLINE reminders #-}
+reminders :: IORef [Reminder]
+reminders = unsafePerformIO (newIORef [])
+
+readReminders :: X [Reminder]
+readReminders = io $ readIORef reminders
+
+adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
+adjustReminders f = io $ modifyIORef reminders f
+
+clearUrgency :: Window -> X ()
+clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
+
+data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
+    deriving (Read, Show)
 
 -- The Non-ICCCM Manifesto:
 -- Note: Some non-standard choices have been made in this implementation to
 -- account for the fact that things are different in a tiling window manager:
---   1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag
---      9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly.
---      so in order to prevent that, we immediately clear the urgency flag.
---   2. In normal window managers, windows may overlap, so clients wait for focus to
+--   1. In normal window managers, windows may overlap, so clients wait for focus to
 --      be set before urgency is cleared. In a tiling WM, it's sufficient to be able
 --      see the window, since we know that means you can see it completely.
---   3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
+--   2. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
 --      has focus, and won't clear until it loses and regains focus. This is stupid.
--- In order to account for these quirks, we clear the urgency bit immediately upon
--- receiving notification (thus suppressing the repeated notifications) and track
--- the list of urgent windows ourselves, allowing us to clear urgency when a window
--- is visible, and not to set urgency if a window is visible.
--- If you have a better idea, please, let us know!
-instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where
-    handleMess (WithUrgencyHook hook) mess
-      | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do
+-- In order to account for these quirks, we track the list of urgent windows
+-- ourselves, allowing us to clear urgency when a window is visible, and not to
+-- set urgency if a window is visible. If you have a better idea, please, let us
+-- know!
+handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
+handleEvent wuh event =
+    case event of
+      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
-              wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
-              when (testBit flags urgencyHintBit) $ do
-                  -- Call the urgencyHook.
-                  userCode $ urgencyHook hook w
-                  -- Clear the bit to prevent repeated notifications, as described above.
-                  io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
-                  -- Add to list of urgents.
+              WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
+              if (testBit flags urgencyHintBit) then do
                   adjustUrgents (\ws -> if elem w ws then ws else w : ws)
-                  -- Call logHook after IORef has been modified.
-                  userCode =<< asks (logHook . config)
-          return Nothing
-      | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do
-          adjustUrgents (delete w)
-          return Nothing
-      | otherwise =
-          return Nothing
+                  callUrgencyHook wuh w
+                else
+                  clearUrgency w
+              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
+      DestroyWindowEvent {ev_window = w} ->
+          clearUrgency w
+      _ ->
+          mapM_ handleReminder =<< readReminders
+      where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
 
-adjustUrgents :: ([Window] -> [Window]) -> X ()
-adjustUrgents f = io $ modifyIORef urgents f
+callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
+callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =
+    whenX (not <$> shouldSuppress sw w) $ do
+        userCodeDef () $ urgencyHook hook w
+        case rw of
+            Repeatedly times int -> addReminder w int $ Just times
+            Every int            -> addReminder w int Nothing
+            Dont                 -> return ()
 
-urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) =>
-                   h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window
-urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook
+addReminder :: Window -> Rational -> Maybe Int -> X ()
+addReminder w int times = do
+    timerId <- startTimer int
+    let reminder = Reminder timerId w int times
+    adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs)
+
+reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a)
+reminderHook (WithUrgencyHook hook _) reminder = do
+    case remaining reminder of
+        Just x | x > 0 -> remind $ Just (x - 1)
+        Just _         -> adjustReminders $ delete reminder
+        Nothing        -> remind Nothing
+    return Nothing
+  where remind remaining' = do userCode $ urgencyHook hook (window reminder)
+                               adjustReminders $ delete reminder
+                               addReminder (window reminder) (interval reminder) remaining'
+
+shouldSuppress :: SuppressWhen -> Window -> X Bool
+shouldSuppress sw w = elem w <$> suppressibleWindows sw
+
+cleanupUrgents :: SuppressWhen -> X ()
+cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw
+
+suppressibleWindows :: SuppressWhen -> X [Window]
+suppressibleWindows Visible  = gets $ S.toList . mapped
+suppressibleWindows OnScreen = gets $ W.index . windowset
+suppressibleWindows Focused  = gets $ maybeToList . W.peek . windowset
+suppressibleWindows Never    = return []
 
 --------------------------------------------------------------------------------
 -- Urgency Hooks
 
 -- | The class definition, and some pre-defined instances.
 
-class (Read h, Show h) => UrgencyHook h a where
-    urgencyHook :: h -> a -> X ()
+class (Read h, Show h) => UrgencyHook h where
+    urgencyHook :: h -> Window -> X ()
 
 data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
 
-instance UrgencyHook NoUrgencyHook Window where
+instance UrgencyHook NoUrgencyHook where
     urgencyHook _ _ = return ()
 
-data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] }
+-- | Your set of options for configuring a dzenUrgencyHook.
+data DzenUrgencyHook = DzenUrgencyHook {
+                         duration :: Int, -- ^ number of microseconds to display the dzen
+                                          --   (hence, you'll probably want to use 'seconds')
+                         args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen
+                       }
     deriving (Read, Show)
 
-instance UrgencyHook DzenUrgencyHook Window where
+instance UrgencyHook DzenUrgencyHook where
     urgencyHook DzenUrgencyHook { duration = d, args = a } w = do
-        visibles <- gets mapped
         name <- getName w
         ws <- gets windowset
-        whenJust (W.findTag w ws) (flash name visibles)
-      where flash name visibles index =
-                  when (not $ S.member w visibles) $
+        whenJust (W.findTag w ws) (flash name)
+      where flash name index =
                   dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d
 
--- | Flashes when a window requests your attention and you can't see it. Configurable
--- duration and args to dzen.
-dzenUrgencyHook :: DzenUrgencyHook
-dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] }
+{- | A hook which will automatically send you to anything which sets the urgent
+  flag (as opposed to printing some sort of message. You would use this as
+  usual, eg.
 
--- For debugging purposes, really.
+  > withUrgencyHook FocusHook $ myconfig { ...
+-}
+data FocusHook = FocusHook deriving (Read, Show)
+
+instance UrgencyHook FocusHook where
+    urgencyHook _ _ = focusUrgent
+
+-- | Flashes when a window requests your attention and you can't see it.
+-- Defaults to a duration of five seconds, and no extra args to dzen.
+-- See 'DzenUrgencyHook'.
+dzenUrgencyHook :: DzenUrgencyHook
+dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }
+
+-- | Spawn a commandline thing, appending the window id to the prefix string
+-- you provide. (Make sure to add a space if you need it.) Do your crazy
+-- xcompmgr thing.
+newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)
+
+instance UrgencyHook SpawnUrgencyHook where
+    urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w
+
+-- | For debugging purposes, really.
 data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
 
-instance UrgencyHook StdoutUrgencyHook Window where
+instance UrgencyHook StdoutUrgencyHook where
     urgencyHook    _ w = io $ putStrLn $ "Urgent: " ++ show w

XMonad/Hooks/WorkspaceByPos.hs

@@ -0,0 +1,54 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.WorkspaceByPos
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Useful in a dual-head setup: Looks at the requested geometry of
+-- new windows and moves them to the workspace of the non-focused
+-- screen if necessary.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.WorkspaceByPos (
+    -- * Usage
+    -- $usage
+    workspaceByPos
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.XUtils (fi)
+
+import Data.Maybe
+import Control.Applicative((<$>))
+import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.WorkspaceByPos
+-- >
+-- > myManageHook = workspaceByPos <+> manageHook defaultConfig
+-- >
+-- > main = xmonad defaultConfig { manageHook = myManageHook }
+
+workspaceByPos :: ManageHook
+workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
+
+needsMoving :: Window -> X (Maybe WorkspaceId)
+needsMoving w = withDisplay $ \d -> do
+    -- only relocate windows with non-zero position
+    wa <- io $ getWindowAttributes d w
+    fmap (const Nothing `either` Just) . runErrorT $ do
+        guard $ wa_x wa /= 0 || wa_y wa /= 0
+        ws <- gets windowset
+        sc <- lift $ fromMaybe (W.current ws)
+                <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
+        Just wkspc <- lift $ screenWorkspace (W.screen sc)
+        guard $ W.currentTag ws /= wkspc
+        return wkspc `asTypeOf` throwError ""

XMonad/Hooks/XPropManage.hs

@@ -34,7 +34,7 @@ import XMonad.ManageHook ((-->))
 -- > import XMonad.Actions.TagWindows
 -- > import Data.List
 --
--- > manageHook = xPropManageHook xPropMatches 
+-- > manageHook = xPropManageHook xPropMatches
 -- >
 -- > xPropMatches :: [XPropMatch]
 -- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2")))
@@ -71,7 +71,7 @@ xPropManageHook tms = mconcat $ map propToHook tms
     where
       propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f
       mkQuery (a, tf)    = fmap tf (getQuery a)
-      mkHook func        = ask >>= Query . lift . fmap Endo . func 
+      mkHook func        = ask >>= Query . lift . fmap Endo . func
 
 getProp :: Display -> Window -> Atom -> X ([String])
 getProp d w p = do

XMonad/Layout/Accordion.hs

@@ -7,7 +7,7 @@
 -- License     :  BSD
 --
 -- Maintainer  :  glasser@mit.edu
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- LayoutClass that puts non-focused windows in ribbons at the top and bottom
@@ -30,8 +30,8 @@ import Data.Ratio
 --
 -- Then edit your @layoutHook@ by adding the Accordion layout:
 --
--- > myLayouts = Accordion ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = Accordion ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --

XMonad/Layout/AutoMaster.hs

@@ -0,0 +1,123 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.AutoMaster
+-- Copyright   :  (c) 2009 Ilya Portnov
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides layout modifier AutoMaster. It separates screen in two parts -
+-- master and slave. Size of slave area automatically changes depending on
+-- number of slave windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.AutoMaster (
+                             -- * Usage
+                             -- $usage
+                             autoMaster
+                            ) where
+import Control.Monad
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutModifier
+
+-- $usage
+-- This module defines layout modifier named autoMaster. It separates
+-- screen in two parts - master and slave. Master windows are arranged
+-- in one row, in slave area underlying layout is run. Size of slave area
+-- automatically increases when number of slave windows is increasing.
+--
+-- You can use this module by adding folowing in your @xmonad.hs@:
+--
+-- > import XMonad.Layout.AutoMaster
+--
+-- Then add layouts to your layoutHook:
+--
+-- > myLayoutHook = autoMaster 1 (1/100) Grid ||| ...
+--
+-- In this example, master area by default contains 1 window (you can
+-- change this number in runtime with usual IncMasterN message), changing
+-- slave area size with 1/100 on each Shrink/Expand message.
+
+-- | Data type for layout modifier
+data AutoMaster a = AutoMaster Int Float Float
+    deriving (Read,Show)
+
+instance LayoutModifier AutoMaster Window where
+    modifyLayout (AutoMaster k bias _) = autoLayout k bias
+    pureMess = autoMess
+
+-- | Handle Shrink/Expand and IncMasterN messages
+autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
+autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),
+                                             fmap incmastern (fromMessage m)]
+    where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta
+          resize Expand = AutoMaster k (min ( 0.4)  $ bias+delta) delta
+          resize Shrink = AutoMaster k (max (-0.4)  $ bias-delta) delta
+
+-- | Main layout function
+autoLayout :: (LayoutClass l Window) =>
+              Int ->
+              Float ->
+              W.Workspace WorkspaceId (l Window) Window
+              -> Rectangle
+              -> X ([(Window, Rectangle)], Maybe (l Window))
+autoLayout k bias wksp rect = do
+    let stack = W.stack wksp
+    let ws = W.integrate' stack
+    let n = length ws
+    if null ws then
+        runLayout wksp rect
+        else do
+          if (n<=k) then
+              return ((divideRow rect ws),Nothing)
+              else do
+              let master = take k ws
+              let filtStack = stack >>= W.filter (\w -> not (w `elem` master))
+              wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias)
+              return ((divideRow (masterRect rect n bias) master) ++ (fst wrs),
+                      snd wrs)
+
+-- | Calculates height of master area, depending on number of windows.
+masterHeight :: Int -> Float -> Float
+masterHeight n bias = (calcHeight n) + bias
+    where calcHeight :: Int -> Float
+          calcHeight 1 = 1.0
+          calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3)
+
+-- | Rectangle for master area
+masterRect :: Rectangle -> Int -> Float -> Rectangle
+masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h
+    where h = round $ (fromIntegral sh)*(masterHeight n bias)
+
+-- | Rectangle for slave area
+slaveRect :: Rectangle -> Int -> Float -> Rectangle
+slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h
+    where mh = round $ (fromIntegral sh)*(masterHeight n bias)
+          h  = round $ (fromIntegral sh)*(1-masterHeight n bias)
+
+-- | Divide rectangle between windows
+divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
+divideRow (Rectangle x y w h) ws = zip ws rects
+    where n = length ws
+          oneW = fromIntegral w `div` n
+          oneRect = Rectangle x y (fromIntegral oneW) h
+          rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect
+
+-- | Shift rectangle right
+shiftR :: Position -> Rectangle -> Rectangle
+shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h
+
+-- | User interface function
+autoMaster :: LayoutClass l a =>
+              Int ->      -- Number of master windows
+              Float ->    -- Step for which to increment/decrement master area size with Shrink/Expand
+              l a ->
+              ModifiedLayout AutoMaster l a
+autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta)
+

XMonad/Layout/BorderResize.hs

@@ -0,0 +1,164 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.BorderResize
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This layout modifier will allow to resize windows by dragging their
+-- borders with the mouse. However, it only works in layouts or modified
+-- layouts that react to the 'SetGeometry' message.
+-- "XMonad.Layout.WindowArranger" can be used to create such a setup.
+-- BorderResize is probably most useful in floating layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BorderResize
+    ( -- * Usage
+      -- $usage
+      borderResize
+    , BorderResize (..)
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.WindowArranger
+import XMonad.Util.XUtils
+import Control.Monad(when,forM)
+import Control.Arrow(first)
+import Control.Applicative((<$>))
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.BorderResize
+-- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...)
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+
+data BorderInfo = RightSideBorder Window Rectangle
+                    | LeftSideBorder Window Rectangle
+                    | TopSideBorder Window Rectangle
+                    | BottomSideBorder Window Rectangle
+                    deriving (Show, Read, Eq)
+type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo)
+type BorderWithWin = (Window, BorderInfo)
+
+data BorderResize a = BR [BorderWithWin] deriving (Show, Read)
+
+brBorderOffset :: Position
+brBorderOffset = 5
+brBorderSize :: Dimension
+brBorderSize = 10
+
+brCursorRightSide :: Glyph
+brCursorRightSide = 96
+brCursorLeftSide :: Glyph
+brCursorLeftSide = 70
+brCursorTopSide :: Glyph
+brCursorTopSide = 138
+brCursorBottomSide :: Glyph
+brCursorBottomSide = 16
+
+borderResize :: l a -> ModifiedLayout BorderResize l a
+borderResize = ModifiedLayout (BR [])
+
+instance LayoutModifier BorderResize Window where
+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
+    redoLayout (BR borders) _ _ wrs = do
+        let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr)
+        mapM_ deleteBorder borders
+        newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) ->
+                        first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4]
+        let wrs' = concat $ map fst newBorders
+            newBordersSerialized = concat $ map snd newBorders
+        return (wrs', Just $ BR newBordersSerialized)
+            -- What we return is the original wrs with the new border
+            -- windows inserted at the correct positions - this way, the core
+            -- will restack the borders correctly.
+            -- We also return information about our borders, so that we
+            -- can handle events that they receive and destroy them when
+            -- they are no longer needed.
+
+    handleMess (BR borders) m
+        | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing
+        | Just _ <- fromMessage m :: Maybe LayoutMessages =
+            mapM_ deleteBorder borders >> return (Just $ BR [])
+    handleMess _ _ = return Nothing
+
+prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect)
+prepareBorders (w, r@(Rectangle x y wh ht)) =
+    ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide     , RightSideBorder w r),
+     (r, (Rectangle (x - brBorderOffset) y brBorderSize ht)         , brCursorLeftSide      , LeftSideBorder w r),
+     (r, (Rectangle x (y - brBorderOffset) wh brBorderSize)         , brCursorTopSide       , TopSideBorder w r),
+     (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide    , BottomSideBorder w r)
+    )
+
+handleResize :: [BorderWithWin] -> Event -> X ()
+handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
+    | et == buttonPress, Just edge <- lookup ew borders =
+    case edge of
+        RightSideBorder hostWin (Rectangle hx hy _ hht) ->
+            mouseDrag (\x _ -> do
+                            let nwh = max 1 $ fi (x - hx)
+                                rect = Rectangle hx hy nwh hht
+                            focus hostWin
+                            when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
+        LeftSideBorder hostWin (Rectangle hx hy hwh hht) ->
+            mouseDrag (\x _ -> do
+                            let nx = max 0 $ min (hx + fi hwh) $ x
+                                nwh = max 1 $ hwh + fi (hx - x)
+                                rect = Rectangle nx hy nwh hht
+                            focus hostWin
+                            when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)
+        TopSideBorder hostWin (Rectangle hx hy hwh hht) ->
+            mouseDrag (\_ y -> do
+                            let ny = max 0 $ min (hy + fi hht) $ y
+                                nht = max 1 $ hht + fi (hy - y)
+                                rect = Rectangle hx ny hwh nht
+                            focus hostWin
+                            when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)
+        BottomSideBorder hostWin (Rectangle hx hy hwh _) ->
+            mouseDrag (\_ y -> do
+                            let nht = max 1 $ fi (y - hy)
+                                rect = Rectangle hx hy hwh nht
+                            focus hostWin
+                            when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
+handleResize _ _ = return ()
+
+createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin))
+createBorder (_, borderRect, borderCursor, borderInfo) = do
+    borderWin <- createInputWindow borderCursor borderRect
+    return ((borderWin, borderRect), (borderWin, borderInfo))
+
+deleteBorder :: BorderWithWin -> X ()
+deleteBorder (borderWin, _) = deleteWindow borderWin
+
+createInputWindow :: Glyph -> Rectangle -> X Window
+createInputWindow cursorGlyph r = withDisplay $ \d -> do
+    win <- mkInputWindow d r
+    io $ selectInput d win (exposureMask .|. buttonPressMask)
+    cursor <- io $ createFontCursor d cursorGlyph
+    io $ defineCursor d win cursor
+    io $ freeCursor d cursor
+    showWindow win
+    return win
+
+mkInputWindow :: Display -> Rectangle -> X Window
+mkInputWindow d (Rectangle x y w h) = do
+  rw <- asks theRoot
+  let screen   = defaultScreenOfDisplay d
+      visual   = defaultVisualOfScreen screen
+      attrmask = cWOverrideRedirect
+  io $ allocaSetWindowAttributes $
+         \attributes -> do
+           set_override_redirect attributes True
+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map

XMonad/Layout/BoringWindows.hs

@@ -0,0 +1,138 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.BoringWindows
+-- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  none
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- BoringWindows is an extension to allow windows to be marked boring
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BoringWindows (
+                                   -- * Usage
+                                   -- $usage
+                                   boringWindows, boringAuto,
+                                   markBoring, clearBoring,
+                                   focusUp, focusDown, focusMaster,
+
+                                   UpdateBoring(UpdateBoring),
+                                   BoringMessage(Replace,Merge),
+                                   BoringWindows()
+                                  ) where
+
+import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
+                                    LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
+import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
+              sendMessage, windows, withFocused, Window)
+import Control.Applicative((<$>))
+import Control.Monad(Monad(return, (>>)))
+import Data.List((\\), union)
+import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,
+                  maybeToList)
+import qualified Data.Map as M
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.BoringWindows
+--
+-- Then edit your @layoutHook@ by adding the layout modifier:
+--
+-- > myLayout = boringWindows (Full ||| etc..)
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- Then to your keybindings, add:
+--
+-- > , ((modm, xK_j), focusUp)
+-- > , ((modm, xK_k), focusDown)
+-- > , ((modm, xK_m), focusMaster)
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+
+data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring
+                     | Replace String [Window]
+                     | Merge String [Window]
+                     deriving ( Read, Show, Typeable )
+
+instance Message BoringMessage
+
+-- | UpdateBoring is sent before attempting to view another boring window, so
+-- that layouts have a chance to mark boring windows.
+data UpdateBoring = UpdateBoring
+    deriving (Typeable)
+instance Message UpdateBoring
+
+markBoring, clearBoring, focusUp, focusDown, focusMaster :: X ()
+markBoring = withFocused (sendMessage . IsBoring)
+clearBoring = sendMessage ClearBoring
+focusUp = sendMessage UpdateBoring >> sendMessage FocusUp
+focusDown = sendMessage UpdateBoring >> sendMessage FocusDown
+focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster
+
+data BoringWindows a = BoringWindows
+    { namedBoring :: M.Map String [a] -- ^ store borings with a specific source
+    , chosenBoring :: [a]             -- ^ user-chosen borings
+    , hiddenBoring :: Maybe [a]       -- ^ maybe mark hidden windows
+    } deriving (Show,Read,Typeable)
+
+boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
+boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing)
+
+-- | Mark windows that are not given rectangles as boring
+boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
+boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))
+
+instance LayoutModifier BoringWindows Window where
+    redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do
+        let bs' = W.integrate' mst \\ map fst arrs
+        return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )
+
+    handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m
+        | Just (Replace k ws) <- fromMessage m
+        , maybe True (ws/=) (M.lookup k nbs) =
+            let nnb = if null ws then M.delete k nbs
+                          else M.insert k ws nbs
+            in rjl bst { namedBoring = nnb }
+        | Just (Merge k ws) <- fromMessage m
+        , maybe True (not . null . (ws \\)) (M.lookup k nbs) =
+            rjl bst { namedBoring = M.insertWith union k ws nbs }
+        | Just (IsBoring w) <- fromMessage m , w `notElem` cbs =
+            rjl bst { chosenBoring = w:cbs }
+        | Just ClearBoring <- fromMessage m, not (null cbs) =
+            rjl bst { namedBoring = M.empty, chosenBoring = []}
+        | Just FocusUp <- fromMessage m =
+                            do windows $ W.modify' $ skipBoring W.focusUp'
+                               return Nothing
+        | Just FocusDown <- fromMessage m =
+                            do windows $ W.modify' $ skipBoring W.focusDown'
+                               return Nothing
+        | Just FocusMaster <- fromMessage m =
+                            do windows $ W.modify'
+                                            $ skipBoring W.focusDown' -- wiggle focus to make sure
+                                            . skipBoring W.focusUp'   -- no boring window gets the focus
+                                            . focusMaster'
+                               return Nothing
+        where skipBoring f st = fromMaybe st $ listToMaybe
+                                $ filter ((`notElem` W.focus st:bs) . W.focus)
+                                $ take (length $ W.integrate st)
+                                $ iterate f st
+              bs = concat $ cbs:maybeToList lbs ++ M.elems nbs
+              rjl = return . Just . Left
+    handleMessOrMaybeModifyIt _ _ = return Nothing
+
+-- | Variant of 'focusMaster' that works on a
+-- 'Stack' rather than an entire 'StackSet'.
+focusMaster' :: W.Stack a -> W.Stack a
+focusMaster' c@(W.Stack _ [] _) = c
+focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls

XMonad/Layout/CenteredMaster.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.CenteredMaster
+-- Copyright   :  (c) 2009 Ilya Portnov
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Two layout modifiers. centerMaster places master window at center,
+-- on top of all other windows, which are managed by base layout.
+-- topRightMaster is similar, but places master window in top right corner
+-- instead of center.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.CenteredMaster (
+         -- * Usage
+         -- $usage
+
+         centerMaster,
+         topRightMaster
+         ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module defines two new layout modifiers: centerMaster and topRightMaster.
+-- centerMaster places master window at center of screen, on top of others.
+-- All other windows in background are managed by base layout.
+-- topRightMaster is like centerMaster, but places master window in top right corner instead of center.
+--
+-- Yo can use this module by adding folowing in your @xmonad.hs@:
+--
+-- > import XMonad.Layout.CenteredMaster
+--
+-- Then add layouts to your layoutHook:
+--
+-- > myLayoutHook = centerMaster Grid ||| ...
+
+-- | Function that decides where master window should be placed
+type Positioner = Rectangle -> Rectangle
+
+-- | Data type for LayoutModifier
+data CenteredMaster a = CenteredMaster deriving (Read,Show)
+
+instance LayoutModifier CenteredMaster Window where
+  modifyLayout CenteredMaster = applyPosition (center (5/7) (5/7))
+
+data TopRightMaster a = TopRightMaster deriving (Read,Show)
+
+instance LayoutModifier TopRightMaster Window where
+  modifyLayout TopRightMaster = applyPosition (topRight (3/7) (1/2))
+
+-- | Modifier that puts master window in center, other windows in background
+-- are managed by given layout
+centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a
+centerMaster = ModifiedLayout CenteredMaster
+
+-- | Modifier that puts master window in top right corner, other windows in background
+-- are managed by given layout
+topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a
+topRightMaster = ModifiedLayout TopRightMaster
+
+-- | Internal function, doing main job
+applyPosition :: (LayoutClass l a, Eq a) =>
+                    Positioner
+                 -> W.Workspace WorkspaceId (l a) a
+                 -> Rectangle
+                 -> X ([(a, Rectangle)], Maybe (l a))
+
+applyPosition pos wksp rect = do
+  let stack = W.stack wksp
+  let ws = W.integrate' $ stack
+  if null ws then
+     runLayout wksp rect
+     else do
+       let first = head ws
+       let other = tail ws
+       let filtStack = stack >>= W.filter (first /=)
+       wrs <- runLayout (wksp {W.stack = filtStack}) rect
+       return ((first, place pos other rect) : fst wrs, snd wrs)
+
+-- | Place master window (it's Rectangle is given), using the given Positioner.
+-- If second argument is empty (that is, there is only one window on workspace),
+-- place that window fullscreen.
+place :: Positioner -> [a] -> Rectangle -> Rectangle
+place _ [] rect = rect
+place pos _ rect = pos rect
+
+-- | Function that calculates Rectangle at top right corner of given Rectangle
+topRight :: Float -> Float -> Rectangle -> Rectangle
+topRight rx ry (Rectangle sx sy sw sh) = Rectangle x sy w h
+  where w = round (fromIntegral sw * rx)
+        h = round (fromIntegral sh * ry)
+        x = sx + fromIntegral (sw-w)
+
+-- | Function that calculates Rectangle at center of given Rectangle.
+center :: Float -> Float -> Rectangle -> Rectangle
+center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h
+  where w = round (fromIntegral sw * rx)
+        h = round (fromIntegral sh * ry)
+        x = sx + fromIntegral (sw-w) `div` 2
+        y = sy + fromIntegral (sh-h) `div` 2
+
+

XMonad/Layout/Circle.hs

@@ -31,8 +31,8 @@ import XMonad.StackSet (integrate, peek)
 --
 -- Then edit your @layoutHook@ by adding the Circle layout:
 --
--- > myLayouts = Circle ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = Circle ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --

XMonad/Layout/Column.hs

@@ -0,0 +1,71 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Column
+-- Copyright   :  (c) 2009 Ilya Portnov
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides Column layout that places all windows in one column. Windows
+-- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is
+-- given. With Shrink/Expand messages you can change the q value.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Column (
+                             -- * Usage
+                             -- $usage
+                             Column (..)
+                            ) where
+import XMonad
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module defines layot named Column. It places all windows in one
+-- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =
+-- q, where `q' is given (thus, windows heights are members of geometric
+-- progression). With Shrink/Expand messages one can change the `q' value.
+--
+-- You can use this module by adding folowing in your @xmonad.hs@:
+--
+-- > import XMonad.Layout.Column
+--
+-- Then add layouts to your layoutHook:
+--
+-- > myLayoutHook = Column 1.6 ||| ...
+--
+-- In this example, each next window will have height 1.6 times less then
+-- previous window.
+
+data Column a = Column Float deriving (Read,Show)
+
+instance LayoutClass Column a where
+    pureLayout = columnLayout
+    pureMessage = columnMessage
+
+columnMessage :: Column a -> SomeMessage -> Maybe (Column a)
+columnMessage (Column q) m = fmap resize (fromMessage m)
+    where resize Shrink = Column (q-0.1)
+          resize Expand = Column (q+0.1)
+
+columnLayout :: Column a -> Rectangle -> W.Stack a -> [(a,Rectangle)]
+columnLayout (Column q) rect stack = zip ws rects
+    where ws = W.integrate stack
+          n = length ws
+          heights = map (xn n rect q) [1..n]
+          ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]]
+          rects = map (mkRect rect) $ zip heights ys
+
+mkRect :: Rectangle -> (Dimension,Position) -> Rectangle
+mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h
+        
+xn :: Int -> Rectangle -> Float -> Int -> Dimension
+xn n (Rectangle _ _ _ h) q k = if q==1 then 
+                                  h `div` (fromIntegral n)
+                               else
+                                  round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))
+
+

XMonad/Layout/Combo.hs

@@ -6,8 +6,8 @@
 -- Module      :  XMonad.Layout.Combo
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
+--
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,7 +17,7 @@
 
 module XMonad.Layout.Combo (
                             -- * Usage
-                            -- $usage 
+                            -- $usage
                             combineTwo,
                             CombineTwo
                            ) where
@@ -25,17 +25,17 @@ module XMonad.Layout.Combo (
 import Data.List ( delete, intersect, (\\) )
 import Data.Maybe ( isJust )
 import XMonad hiding (focus)
-import XMonad.StackSet ( integrate, Stack(..) )
+import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )
 import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
 import qualified XMonad.StackSet as W ( differentiate )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--- 
--- > import XMonad.Layout.Combo 
--- 
+--
+-- > import XMonad.Layout.Combo
+--
 -- and add something like
--- 
+--
 -- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
 --
 -- to your layouts.
@@ -51,10 +51,10 @@ import qualified XMonad.StackSet as W ( differentiate )
 -- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",
 -- and add the following key bindings (or something similar):
 --
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
 --
 -- For detailed instruction on editing the key binding see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -76,7 +76,7 @@ combineTwo = C2 [] []
 
 instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
     => LayoutClass (CombineTwo (l ()) l1 l2) a where
-    doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s)
+    runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
         where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
                               super' <- maybe super id `fmap`
@@ -93,15 +93,14 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
                                                              x -> case origws \\ x of
                                                                   [] -> init x
                                                                   _ -> x
-                         superstack = if focus s `elem` w2'
-                                      then Stack { focus=(), up=[], down=[()] }
-                                      else Stack { focus=(), up=[], down=[()] }
+                         superstack = Stack { focus=(), up=[], down=[()] }
                          s1 = differentiate f' (origws \\ w2')
                          s2 = differentiate f' w2'
-                         f' = focus s:delete (focus s) f
-                     ([((),r1),((),r2)], msuper') <- doLayout super rinput superstack
-                     (wrs1, ml1') <- runLayout l1 r1 s1
-                     (wrs2, ml2') <- runLayout l2 r2 s2
+                         f' = case s of (Just s') -> focus s':delete (focus s') f
+                                        Nothing -> f
+                     ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput
+                     (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
+                     (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
                      return (wrs1++wrs2, Just $ C2 f' w2'
                                      (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))
     handleMessage (C2 f ws2 super l1 l2) m

XMonad/Layout/ComboP.hs

@@ -0,0 +1,180 @@
+{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ComboP
+-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout that combines multiple layouts and allows to specify where to put
+-- new windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.ComboP (
+                             -- * Usage
+                             -- $usage
+                             combineTwoP,
+                             CombineTwoP,
+                             SwapWindow(..),
+                             Property(..)
+                            ) where
+
+import Data.List ( delete, intersect, (\\) )
+import Data.Maybe ( isJust )
+import Control.Monad
+import XMonad hiding (focus)
+import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
+import XMonad.Layout.WindowNavigation
+import XMonad.Util.WindowProperties
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.ComboP
+--
+-- and add something like
+--
+-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox")
+--
+-- to your layouts. This way all windows with class = \"Firefox\" will always go
+-- to the left pane, all others - to the right.
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with
+-- addition of a 'Property' which tells where to put new windows. Windows mathing
+-- the property will go into the first part, all others will go into the second
+-- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces
+-- 'SwapWindow' message which sends focused window to the other part. It is
+-- required because @Move@ commands don't work when one of the parts is empty.
+-- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key
+-- bindings (or something similar):
+--
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_s    ), sendMessage $ SwapWindow)
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data SwapWindow =  SwapWindow        -- ^ Swap window between panes
+                 | SwapWindowN Int   -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow
+                 deriving (Read, Show, Typeable)
+instance Message SwapWindow
+
+data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property
+                                deriving (Read, Show)
+
+combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) =>
+                super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window
+combineTwoP = C2P [] [] []
+
+instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
+    LayoutClass (CombineTwoP (l ()) l1 l2) Window where
+    doLayout (C2P f w1 w2 super l1 l2 prop) rinput s =
+        let origws = W.integrate s           -- passed in windows
+            w1c = origws `intersect` w1      -- current windows in the first pane
+            w2c = origws `intersect` w2      -- current windows in the second pane
+            new = origws \\ (w1c ++ w2c)     -- new windows
+            superstack = Just Stack { focus=(), up=[], down=[()] }
+            f' = focus s:delete (focus s) f  -- list of focused windows, contains 2 elements at most
+        in do
+            matching <- (hasProperty prop) `filterM` new  -- new windows matching predecate
+            let w1' = w1c ++ matching                     -- updated first pane windows
+                w2' = w2c ++ (new \\ matching)            -- updated second pane windows
+                s1 = differentiate f' w1'                 -- first pane stack
+                s2 = differentiate f' w2'                 -- second pane stack
+            ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
+            (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
+            (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
+            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')
+                (maybe l1 id ml1') (maybe l2 id ml2') prop)
+
+    handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
+        | Just SwapWindow      <- fromMessage m = swap us
+        | Just (SwapWindowN 0) <- fromMessage m = swap us
+        | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1
+
+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
+          w1 `elem` ws1,
+          w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop
+
+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
+          w1 `elem` ws2,
+          w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop
+
+        | otherwise = do ml1' <- handleMessage l1 m
+                         ml2' <- handleMessage l2 m
+                         msuper' <- handleMessage super m
+                         if isJust msuper' || isJust ml1' || isJust ml2'
+                            then return $ Just $ C2P f ws1 ws2
+                                                 (maybe super id msuper')
+                                                 (maybe l1 id ml1')
+                                                 (maybe l2 id ml2') prop
+                            else return Nothing
+
+    description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++
+                                description l2 ++ " with " ++ description super ++ " using "++ (show prop)
+
+-- send focused window to the other pane. Does nothing if we don't
+-- own the focused window
+swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>
+        CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
+swap (C2P f ws1 ws2 super l1 l2 prop) = do
+    mst <- gets (W.stack . W.workspace . W.current . windowset)
+    let (ws1', ws2') = case mst of
+            Nothing -> (ws1, ws2)
+            Just st -> if foc `elem` ws1
+                           then (foc `delete` ws1, foc:ws2)
+                           else if foc `elem` ws2
+                               then (foc:ws1, foc `delete` ws2)
+                               else (ws1, ws2)
+                       where foc = W.focus st
+    if (ws1,ws2) == (ws1',ws2')
+        then return Nothing
+        else return $ Just $ C2P f ws1' ws2' super l1 l2 prop
+
+
+-- forwards the message to the sublayout which contains the focused window
+forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>
+                    CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))
+forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do
+    ml1 <- forwardIfFocused l1 ws1 m
+    ml2 <- forwardIfFocused l2 ws2 m
+    ms <- if isJust ml1 || isJust ml2
+            then return Nothing
+            else handleMessage super m
+    if isJust ml1 || isJust ml2 || isJust ms
+        then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop
+        else return Nothing
+
+-- forwards message m to layout l if focused window is among w
+forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))
+forwardIfFocused l w m = do
+    mst <- gets (W.stack . W.workspace . W.current . windowset)
+    maybe (return Nothing) send mst where
+    send st = if (W.focus st) `elem` w
+                then handleMessage l m
+                else return Nothing
+
+-- code from CombineTwo
+-- given two sets of zs and xs takes the first z from zs that also belongs to xs
+-- and turns xs into a stack with z being current element. Acts as
+-- StackSet.differentiate if zs and xs don't intersect
+differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
+differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z
+                                                     , up = reverse $ takeWhile (/=z) xs
+                                                     , down = tail $ dropWhile (/=z) xs }
+                        | otherwise = differentiate zs xs
+differentiate [] xs = W.differentiate xs
+
+-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:

XMonad/Layout/Cross.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-- |
+-- Module      :  XMonad.Layout.Cross
+-- Copyright   :  (c) Luis Cabellos <zhen.sydow@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Luis Cabellos <zhen.sydow@gmail.com>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- A Cross Layout with the main window in the center.
+--
+module XMonad.Layout.Cross(
+                          -- * Usage
+                          -- $usage
+                          simpleCross
+                          , Cross(..) ) where
+
+import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage )
+import XMonad.StackSet( focus, up, down )
+import Control.Monad( msum )
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Cross
+--
+-- Then edit your @layoutHook@ by adding one of the Cross layouts:
+--
+-- > myLayout =  simpleCross ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+
+-- apply a factor to a Rectangle Dimension
+(<%>) :: Dimension -> Rational -> Dimension
+d <%> f = floor $ f * (fromIntegral d)
+
+-- | The Cross Layout draws the focused window in the center of the screen
+--   and part of the other windows on the sides. The 'Shrink' and 'Expand'
+--   messages increment the size of the main window.
+--
+--   The focus keybindings change the center window, while other windows
+--   cycle through the side positions. With the Cross layout only four
+--   windows are shown around the focused window, two ups and two downs,
+--   no matter how many are in the current stack. I.e. focus down cycles the
+--   window below focused into the center; focus up cycles the window above.
+data Cross a = Cross {
+      crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window.
+      crossInc  :: !Rational  -- ^ Percent of main window to increment by when resizing.
+    }
+    deriving( Show, Read )
+
+-- | A simple Cross Layout. It places the focused window in the center.
+--   The proportion of the screen used by the main window is 4\/5.
+simpleCross :: Cross a
+simpleCross = Cross (4/5) (1/100)
+
+instance LayoutClass Cross a where
+    pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++
+                                 (zip winCycle (upRects r f)) ++
+                                 (zip (reverse winCycle) (downRects r f))
+        where winCycle = (up s) ++ (reverse (down s))
+
+    pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]
+        where resize Shrink = Cross (max (1/100) $ f - d) d
+              resize Expand = Cross (min 1 $ f + d) d
+
+    description _ = "Cross"
+
+-- get the Rectangle for the focused window
+mainRect :: Rectangle -> Rational -> Rectangle
+mainRect (Rectangle rx ry rw rh) f = Rectangle
+                                     (rx + (fromIntegral (rw <%> invf)))
+                                     (ry + (fromIntegral (rh <%> invf)))
+                                     (rw <%> f) (rh <%> f)
+    where invf = (1/2) * (1-f)
+
+-- get the rectangles for the up windows
+upRects :: Rectangle -> Rational -> [Rectangle]
+upRects r f = [topRectangle r nf, rightRectangle r nf]
+    where nf = f * (8/10)
+
+-- get the rectangles for the down windows
+downRects :: Rectangle -> Rational -> [Rectangle]
+downRects r f = [bottomRectangle r nf, leftRectangle r nf]
+    where nf = f * (8/10)
+
+topRectangle :: Rectangle -> Rational -> Rectangle
+topRectangle (Rectangle rx ry rw rh) f = Rectangle
+                                         (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
+                                         ry
+                                         (rw <%> f) (rh <%> ((1-f)*(1/2)))
+
+rightRectangle :: Rectangle -> Rational -> Rectangle
+rightRectangle (Rectangle rx ry rw rh) f = Rectangle
+                                           (rx + (fromIntegral (rw - (rw <%> (1/2)))))
+                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
+                                           (rw <%> (1/2)) (rh <%> f)
+
+bottomRectangle :: Rectangle -> Rational -> Rectangle
+bottomRectangle (Rectangle rx ry rw rh) f = Rectangle
+                                            (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
+                                            (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))
+                                            (rw <%> f) (rh <%> ((1-f)*(1/2)))
+
+leftRectangle :: Rectangle -> Rational -> Rectangle
+leftRectangle (Rectangle rx ry rw rh) f = Rectangle
+                                          rx
+                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
+                                           (rw <%> (1/2)) (rh <%> f)
+

XMonad/Layout/Decoration.hs

@@ -0,0 +1,433 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Decoration
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier and a class for easily creating decorated
+-- layouts.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Decoration
+    ( -- * Usage:
+      -- $usage
+      decoration
+    , Theme (..), defaultTheme
+    , Decoration
+    , DecorationMsg (..)
+    , DecorationStyle (..)
+    , DefaultDecoration (..)
+    , Shrinker (..), DefaultShrinker
+    , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile
+    , isInStack, isVisible, isInvisible, isWithin, fi
+    , findWindowByDecoration
+    , module XMonad.Layout.LayoutModifier
+    ) where
+
+import Control.Monad (when)
+import Data.Maybe
+import Data.List
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.UrgencyHook
+import XMonad.Layout.LayoutModifier
+import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList)
+import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.Invisible
+import XMonad.Util.XUtils
+import XMonad.Util.Font
+
+-- $usage
+-- This module is intended for layout developers, who want to decorate
+-- their layouts. End users will not find here very much for them.
+--
+-- For examples of 'DecorationStyle' instances you can have a look at
+-- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed",
+-- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration".
+
+-- | A layout modifier that, with a 'Shrinker', a 'Theme', a
+-- 'DecorationStyle', and a layout, will decorate this layout
+-- according to the decoration style provided.
+--
+-- For some usage examples see "XMonad.Layout.DecorationMadness".
+decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a
+           -> l a -> ModifiedLayout (Decoration ds s) l a
+decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)
+
+-- | A 'Theme' is a record of colors, font etc., to customize a
+-- 'DecorationStyle'.
+--
+-- For a collection of 'Theme's see "XMonad.Util.Themes"
+data Theme =
+    Theme { activeColor         :: String    -- ^ Color of the active window
+          , inactiveColor       :: String    -- ^ Color of the inactive window
+          , urgentColor         :: String    -- ^ Color of the urgent window
+          , activeBorderColor   :: String    -- ^ Color of the border of the active window
+          , inactiveBorderColor :: String    -- ^ Color of the border of the inactive window
+          , urgentBorderColor   :: String    -- ^ Color of the border of the urgent window
+          , activeTextColor     :: String    -- ^ Color of the text of the active window
+          , inactiveTextColor   :: String    -- ^ Color of the text of the inactive window
+          , urgentTextColor     :: String    -- ^ Color of the text of the urgent window
+          , fontName            :: String    -- ^ Font name
+          , decoWidth           :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
+          , decoHeight          :: Dimension -- ^ Height of the decorations
+          } deriving (Show, Read)
+
+-- | The default xmonad 'Theme'.
+defaultTheme :: Theme
+defaultTheme =
+    Theme { activeColor         = "#999999"
+          , inactiveColor       = "#666666"
+          , urgentColor         = "#FFFF00"
+          , activeBorderColor   = "#FFFFFF"
+          , inactiveBorderColor = "#BBBBBB"
+          , urgentBorderColor   = "##00FF00"
+          , activeTextColor     = "#FFFFFF"
+          , inactiveTextColor   = "#BFBFBF"
+          , urgentTextColor     = "#FF0000"
+          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+          , decoWidth           = 200
+          , decoHeight          = 20
+          }
+
+-- | A 'Decoration' layout modifier will handle 'SetTheme', a message
+-- to dynamically change the decoration 'Theme'.
+data DecorationMsg = SetTheme Theme deriving ( Typeable )
+instance Message DecorationMsg
+
+-- | The 'Decoration' state component, where the list of decorated
+-- window's is zipped with a list of decoration. A list of decoration
+-- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'.
+-- The 'Window' will be displayed only if the rectangle is of type
+-- 'Just'.
+data DecorationState =
+    DS { decos :: [(OrigWin,DecoWin)]
+       , font  :: XMonadFont
+       }
+type DecoWin = (Maybe Window, Maybe Rectangle)
+type OrigWin = (Window,Rectangle)
+
+-- | The 'Decoration' 'LayoutModifier'. This data type is an instance
+-- of the 'LayoutModifier' class. This data type will be passed,
+-- together with a layout, to the 'ModifiedLayout' type constructor
+-- to modify the layout by adding decorations according to a
+-- 'DecorationStyle'.
+data Decoration ds s a =
+    Decoration (Invisible Maybe DecorationState) s Theme (ds a)
+    deriving (Show, Read)
+
+-- | The 'DecorationStyle' class, defines methods used in the
+-- implementation of the 'Decoration' 'LayoutModifier' instance. A
+-- type instance of this class is passed to the 'Decoration' type in
+-- order to decorate a layout, by using these methods.
+class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where
+
+    -- | The description that the 'Decoration' modifier will display.
+    describeDeco :: ds a -> String
+    describeDeco ds = show ds
+
+    -- | Shrink the window's rectangle when applying a decoration.
+    shrink :: ds a -> Rectangle -> Rectangle -> Rectangle
+    shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh)
+
+    -- | The decoration event hook, where the
+    -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are
+    -- called. If you reimplement it those methods will not be
+    -- called.
+    decorationEventHook :: ds a -> DecorationState -> Event -> X ()
+    decorationEventHook ds s e = do decorationMouseFocusHook  ds s e
+                                    decorationMouseDragHook   ds s e
+
+    -- | This method is called when the user clicks the pointer over
+    -- the decoration.
+    decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X ()
+    decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e
+
+    -- | This method is called when the user starts grabbing the
+    -- decoration.
+    decorationMouseDragHook :: ds a -> DecorationState -> Event -> X ()
+    decorationMouseDragHook _ s e = handleMouseFocusDrag True s e
+
+    -- | The pure version of the main method, 'decorate'.
+    pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle
+                   -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle
+    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w
+                                                         then Just $ Rectangle x y wh ht
+                                                         else Nothing
+
+    -- | Given the theme's decoration width and height, the screen
+    -- rectangle, the windows stack, the list of windows and
+    -- rectangles returned by the underlying layout and window to be
+    -- decorated, tupled with its rectangle, produce a 'Just'
+    -- 'Rectangle' or 'Nothing' if the window is not to be decorated.
+    decorate :: ds a -> Dimension -> Dimension -> Rectangle
+             -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle)
+    decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr
+
+-- | The default 'DecorationStyle', with just the default methods'
+-- implementations.
+data DefaultDecoration a = DefaultDecoration deriving ( Read, Show )
+instance Eq a => DecorationStyle DefaultDecoration a
+
+-- | The long 'LayoutModifier' instance for the 'Decoration' type.
+--
+-- In 'redoLayout' we check the state: if there is no state we
+-- initialize it.
+--
+-- The state is 'diff'ed against the list of windows produced by the
+-- underlying layout: removed windows get deleted and new ones
+-- decorated by 'createDecos', which will call 'decorate' to decide if
+-- a window must be given a 'Rectangle', in which case a decoration
+-- window will be created.
+--
+-- After that we resync the updated state with the windows' list and
+-- then we process the resynced stated (as we do with a new state).
+--
+-- First we map the decoration windows, we update each decoration to
+-- reflect any decorated window's change, and we insert, in the list
+-- of windows and rectangles returned by the underlying layout, the
+-- decoration for each window. This way xmonad will restack the
+-- decorations and their windows accordingly. At the end we remove
+-- invisible\/stacked windows.
+--
+-- Message handling is quite simple: when needed we release the state
+-- component of the 'Decoration' 'LayoutModifier'. Otherwise we call
+-- 'handleEvent', which will call the appropriate 'DecorationStyle'
+-- methods to perform its tasks.
+instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where
+    redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do
+        releaseResources s
+        return ([], Just $ Decoration (I Nothing) sh t ds)
+    redoLayout _                                 _ Nothing _  = return ([], Nothing)
+
+    redoLayout (Decoration st sh t ds) sc (Just stack) wrs
+        | I Nothing  <- st = initState t ds sc stack wrs >>= processState
+        | I (Just s) <- st = do let dwrs  = decos s
+                                    (d,a) = curry diff (get_ws dwrs) ws
+                                    toDel = todel d dwrs
+                                    toAdd = toadd a wrs
+                                deleteDecos (map snd toDel)
+                                let ndwrs = zip toAdd $ repeat (Nothing,Nothing)
+                                ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs
+                                processState (s {decos = ndecos })
+        | otherwise        = return (wrs, Nothing)
+
+        where
+          ws        = map fst wrs
+          get_w     = fst . fst
+          get_ws    = map get_w
+          del_dwrs  = listFromList get_w notElem
+          find_dw i = fst . snd . flip (!!) i
+          todel   d = filter (flip elem d . get_w)
+          toadd   a = filter (flip elem a . fst  )
+
+          check_dwr dwr = case dwr of
+                            (Nothing, Just dr) -> do dw <- createDecoWindow t dr
+                                                     return (Just dw, Just dr)
+                            _                 -> return dwr
+
+          resync _         [] = return []
+          resync d ((w,r):xs) = case  w `elemIndex` get_ws d of
+                                  Just i  -> do dr   <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r)
+                                                dwr  <- check_dwr (find_dw i d, dr)
+                                                dwrs <- resync d xs
+                                                return $ ((w,r),dwr) : dwrs
+                                  Nothing -> resync d xs
+
+          -- We drop any windows that are *precisely* stacked underneath
+          -- another window: these must be intended to be tabbed!
+          remove_stacked rs ((w,r):xs)
+              | r `elem` rs   = remove_stacked rs xs
+              | otherwise     = (w,r) : remove_stacked (r:rs) xs
+          remove_stacked _ [] = []
+
+          insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs
+          insert_dwr (x    ,(     _ ,     _ )) xs = x:xs
+
+          dwrs_to_wrs    = remove_stacked [] . foldr insert_dwr []
+
+          processState s = do let ndwrs = decos s
+                              showDecos (map snd ndwrs)
+                              updateDecos sh t (font s) ndwrs
+                              return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds))
+
+    handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m
+        | Just e <- fromMessage m                = do decorationEventHook ds s e
+                                                      handleEvent sh t s e
+                                                      return Nothing
+        | Just Hide             <- fromMessage m = do hideDecos (map snd dwrs)
+                                                      return Nothing
+        | Just (SetTheme nt)    <- fromMessage m = do releaseResources s
+                                                      return $ Just $ Decoration (I Nothing) sh nt ds
+        | Just ReleaseResources <- fromMessage m = do releaseResources s
+                                                      return $ Just $ Decoration (I Nothing) sh t  ds
+    handleMess _ _ = return Nothing
+
+    modifierDescription (Decoration _ _ _ ds) = describeDeco ds
+
+-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'
+-- only.
+handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()
+handleEvent sh t (DS dwrs fs) e
+    | PropertyEvent {ev_window = w} <- e
+    , Just i <- w `elemIndex`             (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i)
+    | ExposeEvent   {ev_window = w} <- e
+    , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i)
+handleEvent _ _ _ _ = return ()
+
+-- | Mouse focus and mouse drag are handled by the same function, this
+-- way we can start dragging unfocused windows too.
+handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X ()
+handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window     = ew
+                                               , ev_event_type = et
+                                               , ev_x_root     = ex
+                                               , ev_y_root     = ey }
+    | et == buttonPress
+    , Just ((mainw,r),_) <- lookFor ew dwrs = do
+                              focus mainw
+                              when b $ mouseDrag (\x y -> do
+                                                    let rect = Rectangle (x - (fi ex - rect_x r))
+                                                                         (y - (fi ey - rect_y r))
+                                                                         (rect_width  r)
+                                                                         (rect_height r)
+                                                    sendMessage (SetGeometry rect)) (return ())
+handleMouseFocusDrag _ _ _ = return ()
+
+-- | Given a window and the state, if a matching decoration is in the
+-- state return it with its ('Maybe') 'Rectangle'.
+lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))
+lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr))
+                                   | otherwise = lookFor w dwrs
+lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs
+lookFor _ [] = Nothing
+
+findWindowByDecoration :: Window -> DecorationState -> Maybe (OrigWin,(Window,Maybe Rectangle))
+findWindowByDecoration w ds = lookFor w (decos ds)
+
+-- | Initialize the 'DecorationState' by initializing the font
+-- structure and by creating the needed decorations.
+initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle
+          -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState
+initState t ds sc s wrs = do
+  fs   <- initXMF (fontName t)
+  dwrs <- createDecos t ds sc s wrs wrs
+  return $ DS dwrs fs
+
+-- | Delete windows stored in the state and release the font structure.
+releaseResources :: DecorationState -> X ()
+releaseResources s = do
+  deleteDecos (map snd $ decos s)
+  releaseXMF  (font s)
+
+-- | Create the decoration windows of a list of windows and their
+-- rectangles, by calling the 'decorate' method of the
+-- 'DecorationStyle' received.
+createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window
+            -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)]
+createDecos t ds sc s wrs ((w,r):xs) = do
+  deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r)
+  case deco of
+    Just dr -> do dw   <- createDecoWindow t dr
+                  dwrs <- createDecos t ds sc s wrs xs
+                  return $ ((w,r), (Just dw, Just dr)) : dwrs
+    Nothing -> do dwrs <- createDecos t ds sc s wrs xs
+                  return $ ((w,r), (Nothing, Nothing)) : dwrs
+createDecos _ _ _ _ _ [] = return []
+
+createDecoWindow :: Theme -> Rectangle -> X Window
+createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in
+                       createNewWindow r mask (inactiveColor t) True
+
+showDecos :: [DecoWin] -> X ()
+showDecos = showWindows . catMaybes . map fst
+
+hideDecos :: [DecoWin] -> X ()
+hideDecos = hideWindows . catMaybes . map fst
+
+deleteDecos :: [DecoWin] -> X ()
+deleteDecos = deleteWindows . catMaybes . map fst
+
+updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X ()
+updateDecos s t f = mapM_ $ updateDeco s t f
+
+-- | Update a decoration window given a shrinker, a theme, the font
+-- structure and the needed 'Rectangle's
+updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X ()
+updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
+  nw  <- getName w
+  ur  <- readUrgents
+  dpy <- asks display
+  let focusColor win ic ac uc = (maybe ic (\focusw -> case () of
+                                                       _ | focusw == win -> ac
+                                                         | win `elem` ur -> uc
+                                                         | otherwise     -> ic) . W.peek)
+                                `fmap` gets windowset
+  (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)
+                                  (activeColor   t, activeBorderColor   t, activeTextColor   t)
+                                  (urgentColor   t, urgentBorderColor   t, urgentTextColor   t)
+  let s = shrinkIt sh
+  name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
+                                  return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
+  paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name
+updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
+updateDeco _ _ _ _ = return ()
+
+-- | True if the window is in the 'Stack'. The 'Window' comes second
+-- to facilitate list processing, even though @w \`isInStack\` s@ won't
+-- work...;)
+isInStack :: Eq a => W.Stack a -> a -> Bool
+isInStack s = flip elem (W.integrate s)
+
+-- | Given a 'Rectangle' and a list of 'Rectangle's is True if the
+-- 'Rectangle' is not completely contained by any 'Rectangle' of the
+-- list.
+isVisible :: Rectangle -> [Rectangle] -> Bool
+isVisible r = and . foldr f []
+    where f x xs = if r `isWithin` x then False : xs else True : xs
+
+-- | The contrary of 'isVisible'.
+isInvisible :: Rectangle -> [Rectangle] -> Bool
+isInvisible r = not . isVisible r
+
+-- | True is the first 'Rectangle' is totally within the second
+-- 'Rectangle'.
+isWithin :: Rectangle -> Rectangle -> Bool
+isWithin (Rectangle x y w h) (Rectangle rx ry rw rh)
+    | x >= rx, x <= rx + fi rw
+    , y >= ry, y <= ry + fi rh
+    , x + fi w <= rx + fi rw
+    , y + fi h <= ry + fi rh = True
+    | otherwise              = False
+
+shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
+shrinkWhile sh p x = sw $ sh x
+    where sw [n] = return n
+          sw [] = return ""
+          sw (n:ns) = do
+                        cond <- p n
+                        if cond
+                          then sw ns
+                          else return n
+
+data CustomShrink = CustomShrink
+instance Show CustomShrink where show _ = ""
+instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)]
+
+class (Read s, Show s) => Shrinker s where
+    shrinkIt :: s -> String -> [String]
+
+data DefaultShrinker = DefaultShrinker
+instance Show DefaultShrinker where show _ = ""
+instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)]
+instance Shrinker DefaultShrinker where
+    shrinkIt _ "" = [""]
+    shrinkIt s cs = cs : shrinkIt s (init cs)
+
+shrinkText :: DefaultShrinker
+shrinkText = DefaultShrinker

XMonad/Layout/DecorationMadness.hs

@@ -0,0 +1,600 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DecorationMadness
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A collection of decorated layouts: some of them may be nice, some
+-- usable, others just funny.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DecorationMadness
+    ( -- * Usage
+      -- $usage
+
+      -- * Decorated layouts based on Circle
+      -- $circle
+      circleSimpleDefault
+    , circleDefault
+    , circleSimpleDefaultResizable
+    , circleDefaultResizable
+    , circleSimpleDeco
+    , circleSimpleDecoResizable
+    , circleDeco
+    , circleDecoResizable
+    , circleSimpleDwmStyle
+    , circleDwmStyle
+    , circleSimpleTabbed
+    , circleTabbed
+    -- * Decorated layouts based on Accordion
+    -- $accordion
+    , accordionSimpleDefault
+    , accordionDefault
+    , accordionSimpleDefaultResizable
+    , accordionDefaultResizable
+    , accordionSimpleDeco
+    , accordionSimpleDecoResizable
+    , accordionDeco
+    , accordionDecoResizable
+    , accordionSimpleDwmStyle
+    , accordionDwmStyle
+    , accordionSimpleTabbed
+    , accordionTabbed
+    -- * Tall decorated layouts
+    -- $tall
+    , tallSimpleDefault
+    , tallDefault
+    , tallSimpleDefaultResizable
+    , tallDefaultResizable
+    , tallSimpleDeco
+    , tallDeco
+    , tallSimpleDecoResizable
+    , tallDecoResizable
+    , tallSimpleDwmStyle
+    , tallDwmStyle
+    , tallSimpleTabbed
+    , tallTabbed
+    -- * Mirror Tall decorated layouts
+    -- $mirror
+    , mirrorTallSimpleDefault
+    , mirrorTallDefault
+    , mirrorTallSimpleDefaultResizable
+    , mirrorTallDefaultResizable
+    , mirrorTallSimpleDeco
+    , mirrorTallDeco
+    , mirrorTallSimpleDecoResizable
+    , mirrorTallDecoResizable
+    , mirrorTallSimpleDwmStyle
+    , mirrorTallDwmStyle
+    , mirrorTallSimpleTabbed
+    , mirrorTallTabbed
+    -- * Floating decorated layouts
+    -- $float
+    , floatSimpleSimple
+    , floatSimple
+    , floatSimpleDefault
+    , floatDefault
+    , floatSimpleDwmStyle
+    , floatDwmStyle
+    , floatSimpleTabbed
+    , floatTabbed
+    , defaultTheme, shrinkText
+    ) where
+
+import XMonad
+import XMonad.Actions.MouseResize
+import XMonad.Layout.Decoration
+import XMonad.Layout.DwmStyle
+import XMonad.Layout.SimpleDecoration
+import XMonad.Layout.TabBarDecoration
+
+import XMonad.Layout.Accordion
+import XMonad.Layout.Circle
+import XMonad.Layout.ResizeScreen
+import XMonad.Layout.WindowArranger
+import XMonad.Layout.SimpleFloat
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.DecorationMadness
+--
+-- Then edit your @layoutHook@ by adding the layout you want:
+--
+-- > main = xmonad defaultConfig { layoutHook = someMadLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You can also edit the default theme:
+--
+-- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000"
+-- >                        , activeTextColor     = "#00FF00" }
+--
+-- and
+--
+-- > mylayout = tabbed shrinkText myTheme ||| Full ||| etc..
+--
+-- When a layout is resizable, this means two different things: you
+-- can grab a window's decoration with the pointer and move it around,
+-- and you can move and resize windows with the keyboard. For setting
+-- up the key bindings, please read the documentation of
+-- "XMonad.Layout.WindowArranger"
+--
+-- The default theme can be dynamically change with the xmonad theme
+-- selector. See "XMonad.Prompt.Theme". For more themes, look at
+-- "XMonad.Util.Themes"
+
+-- $circle
+-- Here you will find 'Circle' based decorated layouts.
+
+-- | A 'Circle' layout with the xmonad default decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefault.png>
+circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window
+circleSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Circle
+
+-- | Similar to 'circleSimpleDefault' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+circleDefault :: Shrinker s => s -> Theme
+              -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window
+circleDefault s t = decoration s t DefaultDecoration Circle
+
+-- | A 'Circle' layout with the xmonad simple decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDeco.png>
+circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window
+circleSimpleDeco = decoration shrinkText defaultTheme (Simple True) Circle
+
+-- | Similar to 'circleSimpleDece' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+circleDeco :: Shrinker s => s -> Theme
+           -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window
+circleDeco s t = decoration s t (Simple True) Circle
+
+-- | A 'Circle' layout with the xmonad default decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefaultResizable.png>
+circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Circle)
+
+-- | Similar to 'circleSimpleDefaultResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+circleDefaultResizable :: Shrinker s => s -> Theme
+                       -> ModifiedLayout (Decoration DefaultDecoration s)
+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle)
+
+-- | A 'Circle' layout with the xmonad simple decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDecoResizable.png>
+circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Circle)
+
+-- | Similar to 'circleSimpleDecoResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+circleDecoResizable :: Shrinker s => s -> Theme
+                    -> ModifiedLayout (Decoration SimpleDecoration s)
+                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
+circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle)
+
+-- | A 'Circle' layout with the xmonad DwmStyle decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDwmStyle.png>
+circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window
+circleSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Circle
+
+-- | Similar to 'circleSimpleDwmStyle' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+circleDwmStyle :: Shrinker s => s -> Theme
+               -> ModifiedLayout (Decoration DwmStyle s) Circle Window
+circleDwmStyle s t = decoration s t Dwm Circle
+
+-- | A 'Circle' layout with the xmonad tabbed decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleTabbed.png>
+circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window
+circleSimpleTabbed = simpleTabBar Circle
+
+-- | Similar to 'circleSimpleTabbed' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+circleTabbed :: Shrinker s => s -> Theme
+             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window
+circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle)
+
+
+-- $accordion
+-- Here you will find decorated layouts based on the 'Accordion'
+-- layout.
+
+-- | An 'Accordion' layout with the xmonad default decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDefault.png>
+accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window
+accordionSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Accordion
+
+-- | Similar to 'accordionSimpleDefault' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+accordionDefault :: Shrinker s => s -> Theme
+                 -> ModifiedLayout (Decoration DefaultDecoration s) Accordion Window
+accordionDefault s t = decoration s t DefaultDecoration Accordion
+
+-- | An 'Accordion' layout with the xmonad simple decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDeco.png>
+accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window
+accordionSimpleDeco = decoration shrinkText defaultTheme (Simple True) Accordion
+
+-- | Similar to 'accordionSimpleDece' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+accordionDeco :: Shrinker s => s -> Theme
+              -> ModifiedLayout (Decoration SimpleDecoration s) Accordion Window
+accordionDeco s t = decoration s t (Simple True) Accordion
+
+-- | An 'Accordion' layout with the xmonad default decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
+                                   (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
+accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Accordion)
+
+-- | Similar to 'accordionSimpleDefaultResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+accordionDefaultResizable :: Shrinker s => s -> Theme
+                          -> ModifiedLayout (Decoration DefaultDecoration s)
+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
+accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Accordion)
+
+-- | An 'Accordion' layout with the xmonad simple decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
+accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Accordion)
+
+-- | Similar to 'accordionSimpleDecoResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+accordionDecoResizable :: Shrinker s => s -> Theme
+                       -> ModifiedLayout (Decoration SimpleDecoration s)
+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
+accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Accordion)
+
+-- | An 'Accordion' layout with the xmonad DwmStyle decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDwmStyle.png>
+accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window
+accordionSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Accordion
+
+-- | Similar to 'accordionSimpleDwmStyle' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+accordionDwmStyle :: Shrinker s => s -> Theme
+                  -> ModifiedLayout (Decoration DwmStyle s) Accordion Window
+accordionDwmStyle s t = decoration s t Dwm Accordion
+
+-- | An 'Accordion' layout with the xmonad tabbed decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleTabbed.png>
+accordionSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window
+accordionSimpleTabbed = simpleTabBar Accordion
+
+-- | Similar to 'accordionSimpleTabbed' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+accordionTabbed :: Shrinker s => s -> Theme
+                -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Accordion) Window
+accordionTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Accordion)
+
+
+-- $tall
+-- In this section you will find decorated layouts based on the
+-- 'Tall' layout.
+
+tall :: Tall Window
+tall = Tall 1 (3/100) (1/2)
+
+-- | A 'Tall' layout with the xmonad default decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefault.png>
+tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window
+tallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration tall
+
+-- | Similar to 'tallSimpleDefault' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+tallDefault :: Shrinker s => s -> Theme
+            -> ModifiedLayout (Decoration DefaultDecoration s) Tall Window
+tallDefault s t = decoration s t DefaultDecoration tall
+
+-- | A 'Tall' layout with the xmonad simple decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDeco.png>
+tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window
+tallSimpleDeco = decoration shrinkText defaultTheme (Simple True) tall
+
+-- | Similar to 'tallSimpleDece' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+tallDeco :: Shrinker s => s -> Theme
+         -> ModifiedLayout (Decoration SimpleDecoration s) Tall Window
+tallDeco s t = decoration s t (Simple True) tall
+
+-- | A 'Tall' layout with the xmonad default decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefaultResizable.png>
+tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
+                              (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
+tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange tall)
+
+-- | Similar to 'tallSimpleDefaultResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+tallDefaultResizable :: Shrinker s => s -> Theme
+                     -> ModifiedLayout (Decoration DefaultDecoration s)
+                        (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
+tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange tall)
+
+-- | A 'Tall' layout with the xmonad simple decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDecoResizable.png>
+tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+                           (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
+tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange tall)
+
+-- | Similar to 'tallSimpleDecoResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+tallDecoResizable :: Shrinker s => s -> Theme
+                  -> ModifiedLayout (Decoration SimpleDecoration s)
+                     (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
+tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange tall)
+
+-- | A 'Tall' layout with the xmonad DwmStyle decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDwmStyle.png>
+tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window
+tallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm tall
+
+-- | Similar to 'tallSimpleDwmStyle' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+tallDwmStyle :: Shrinker s => s -> Theme
+             -> ModifiedLayout (Decoration DwmStyle s) Tall Window
+tallDwmStyle s t = decoration s t Dwm tall
+
+-- | A 'Tall' layout with the xmonad tabbed decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleTabbed.png>
+tallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window
+tallSimpleTabbed = simpleTabBar tall
+
+-- | Similar to 'tallSimpleTabbed' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+tallTabbed :: Shrinker s => s -> Theme
+           -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Tall) Window
+tallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) tall)
+
+-- $mirror
+-- In this section you will find decorated layouts based on the
+-- 'Mirror' layout modifier applied to 'Tall'.
+
+mirrorTall :: Mirror Tall Window
+mirrorTall = Mirror tall
+
+-- | A 'Mirror Tall' layout with the xmonad default decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefault.png>
+mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window
+mirrorTallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration mirrorTall
+
+-- | Similar to 'mirrorTallSimpleDefault' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+mirrorTallDefault :: Shrinker s => s -> Theme
+                  -> ModifiedLayout (Decoration DefaultDecoration s) (Mirror Tall) Window
+mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall
+
+-- | A 'Mirror Tall' layout with the xmonad simple decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDeco.png>
+mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window
+mirrorTallSimpleDeco = decoration shrinkText defaultTheme (Simple True) mirrorTall
+
+-- | Similar to 'mirrorTallSimpleDece' but with the possibility of
+-- setting a custom shrinker and a custom theme.
+mirrorTallDeco :: Shrinker s => s -> Theme
+               -> ModifiedLayout (Decoration SimpleDecoration s) (Mirror Tall) Window
+mirrorTallDeco s t = decoration s t (Simple True) mirrorTall
+
+-- | A 'Mirror Tall' layout with the xmonad default decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefaultResizable.png>
+mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
+                                    (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
+mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange mirrorTall)
+
+-- | Similar to 'mirrorTallSimpleDefaultResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+mirrorTallDefaultResizable :: Shrinker s => s -> Theme
+                           -> ModifiedLayout (Decoration DefaultDecoration s)
+                              (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
+mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange mirrorTall)
+
+-- | A 'Mirror Tall' layout with the xmonad simple decoration, default
+-- theme and default shrinker, but with the possibility of moving
+-- windows with the mouse, and resize\/move them with the keyboard.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDecoResizable.png>
+mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+                                 (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
+mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange mirrorTall)
+
+-- | Similar to 'mirrorTallSimpleDecoResizable' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+mirrorTallDecoResizable :: Shrinker s => s -> Theme
+                        -> ModifiedLayout (Decoration SimpleDecoration s)
+                           (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
+mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange mirrorTall)
+
+-- | A 'Mirror Tall' layout with the xmonad DwmStyle decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDwmStyle.png>
+mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window
+mirrorTallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm mirrorTall
+
+-- | Similar to 'mirrorTallSimpleDwmStyle' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+mirrorTallDwmStyle :: Shrinker s => s -> Theme
+                   -> ModifiedLayout (Decoration DwmStyle s) (Mirror Tall) Window
+mirrorTallDwmStyle s t = decoration s t Dwm mirrorTall
+
+-- | A 'Mirror Tall' layout with the xmonad tabbed decoration, default
+-- theme and default shrinker.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleTabbed.png>
+mirrorTallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window
+mirrorTallSimpleTabbed = simpleTabBar mirrorTall
+
+-- | Similar to 'mirrorTallSimpleTabbed' but with the
+-- possibility of setting a custom shrinker and a custom theme.
+mirrorTallTabbed :: Shrinker s => s -> Theme
+                 -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window
+mirrorTallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) mirrorTall)
+
+-- $float
+-- Here you will find decorated layout based on the SimpleFloating
+-- layout
+
+-- | A simple floating layout where every window is placed according
+-- to the window's initial attributes.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleSimple.png>
+floatSimpleSimple :: (Show a, Eq a) => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+                 (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatSimpleSimple = simpleFloat
+
+floatSimple :: (Show a, Eq a, Shrinker s) => s -> Theme ->
+               ModifiedLayout (Decoration SimpleDecoration s)
+          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatSimple = simpleFloat'
+
+-- | This version is decorated with the 'DefaultDecoration' style.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDefault.png>
+floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
+                  (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20)
+
+-- | Same as 'floatSimpleDefault', but with the possibility of setting a
+-- custom shrinker and a custom theme.
+floatDefault :: (Show a, Eq a, Shrinker s) => s -> Theme ->
+                ModifiedLayout (Decoration DefaultDecoration s)
+           (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight t))
+
+-- | This version is decorated with the 'DwmStyle'. Note that this is
+-- a keyboard only floating layout.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDwmStyle.png>
+floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker)
+                   (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (mouseResize $ windowArrangeAll $ SF 20)
+
+-- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a
+-- custom shrinker and a custom theme.
+floatDwmStyle :: (Show a, Eq a, Shrinker s) => s -> Theme ->
+                 ModifiedLayout (Decoration DwmStyle s)
+            (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight t))
+
+-- | This version is decorated with the 'TabbedDecoration' style.
+-- | Mouse dragging is somehow weird.
+--
+-- Here you can find a screen shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleTabbed.png>
+floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)
+                 (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatSimpleTabbed = tabBar shrinkText defaultTheme Top (mouseResize $ windowArrangeAll $ SF 20)
+
+-- | Same as 'floatSimpleTabbed', but with the possibility of setting a
+-- custom shrinker and a custom theme.
+floatTabbed :: (Show a, Eq a, Shrinker s) => s -> Theme ->
+               ModifiedLayout (Decoration TabBarDecoration s)
+          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+floatTabbed s t = tabBar s t Top (mouseResize $ windowArrangeAll $ SF (decoHeight t))

XMonad/Layout/Dishes.hs

@@ -33,8 +33,8 @@ import Control.Monad (ap)
 --
 -- Then edit your @layoutHook@ by adding the Dishes layout:
 --
--- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = Dishes 2 (1/6) ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --

XMonad/Layout/DragPane.hs

@@ -1,16 +1,14 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.DragPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 --                    David Roundy <droundy@darcs.net>,
 --                    Andrea Rossato <andrea.rossato@unibz.it>
 -- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
---                Andrea Rossato <andrea.rossato@unibz.it>
+--
+-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -31,7 +29,7 @@ module XMonad.Layout.DragPane (
 import XMonad
 import Data.Unique
 
-import qualified XMonad.StackSet as W 
+import qualified XMonad.StackSet as W
 import XMonad.Util.Invisible
 import XMonad.Util.XUtils
 
@@ -42,8 +40,8 @@ import XMonad.Util.XUtils
 --
 -- Then edit your @layoutHook@ by adding the DragPane layout:
 --
--- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
@@ -58,8 +56,8 @@ handleColor = "#000000"
 dragPane :: DragType -> Double -> Double -> DragPane a
 dragPane t x y = DragPane (I Nothing) t x y
 
-data DragPane a = 
-    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double 
+data DragPane a =
+    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double
              deriving ( Show, Read )
 
 data DragType = Horizontal | Vertical deriving ( Show, Read )
@@ -88,7 +86,7 @@ handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
 handleMess _ _ = return Nothing
 
 handleEvent :: DragPane a -> Event -> X ()
-handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) 
+handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
             (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
     | t == buttonPress && thisw == win || thisbw == win  = do
   mouseDrag (\ex ey -> do
@@ -107,7 +105,7 @@ doLay mirror (DragPane mw ty delta split) r s = do
                                mirror $ Rectangle x y (w-halfHandleWidth) h
       right = case right' of
                 Rectangle x y w h ->
-		    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
+                    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
       handr = case left' of
                 Rectangle x y w h ->
                     mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
@@ -116,12 +114,12 @@ doLay mirror (DragPane mw ty delta split) r s = do
               [] -> case W.down s of
                       (next:_) -> [(W.focus s,left),(next,right)]
                       [] -> [(W.focus s, r)]
-  if length wrs > 1 
+  if length wrs > 1
      then case mw of
-            I (Just (w,_,ident)) -> do 
+            I (Just (w,_,ident)) -> do
                     w' <- deleteWindow w >> newDragWin handr
                     return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
-            I Nothing -> do 
+            I Nothing -> do
                     w <- newDragWin handr
                     i <- io $ newUnique
                     return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
@@ -131,6 +129,8 @@ doLay mirror (DragPane mw ty delta split) r s = do
 newDragWin :: Rectangle -> X Window
 newDragWin r = do
   let mask = Just $ exposureMask .|. buttonPressMask
-  w <- createNewWindow r mask handleColor
+  w <- createNewWindow r mask handleColor False
   showWindow  w
+  d <- asks display
+  liftIO $ lowerWindow d w
   return      w

XMonad/Layout/DwmStyle.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DwmStyle
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier for decorating windows in a dwm like style.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DwmStyle
+    ( -- * Usage:
+      -- $usage
+      dwmStyle
+    , Theme (..)
+    , defaultTheme
+    , DwmStyle (..)
+    , shrinkText, CustomShrink(CustomShrink)
+    , Shrinker(..)
+    ) where
+
+import XMonad
+import XMonad.StackSet ( Stack (..) )
+import XMonad.Layout.Decoration
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.DwmStyle
+--
+-- Then edit your @layoutHook@ by adding the DwmStyle decoration to
+-- your layout:
+--
+-- > myL = dwmStyle shrinkText defaultTheme (layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You can also edit the default configuration options.
+--
+-- > myDWConfig = defaultTheme { inactiveBorderColor = "red"
+-- >                           , inactiveTextColor   = "red"}
+--
+-- and
+--
+-- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig)
+--
+-- A complete xmonad.hs file for this would therefore be:
+--
+-- > import XMonad
+-- > import XMonad.Layout.DwmStyle
+-- >
+-- > main = xmonad defaultConfig {
+-- >                    layoutHook =
+-- >                        dwmStyle shrinkText defaultTheme
+-- >                            (layoutHook defaultConfig)
+-- >              }
+--
+
+
+-- | Add simple old dwm-style decorations to windows of a layout.
+dwmStyle :: (Eq a, Shrinker s) => s -> Theme
+         -> l a -> ModifiedLayout (Decoration DwmStyle s) l a
+dwmStyle s c = decoration s c Dwm
+
+data DwmStyle a = Dwm deriving (Show, Read)
+
+instance Eq a => DecorationStyle DwmStyle a where
+    describeDeco _ = "DwmStyle"
+    shrink  _ _  r = r
+    pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) =
+        if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht)
+            where nwh = min wid $ fi wh
+                  nx  = fi x + wid - nwh

XMonad/Layout/FixedColumn.hs

@@ -0,0 +1,91 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.FixedColumn
+-- Copyright   :  (c) 2008 Justin Bogner <mail@justinbogner.com>
+-- License     :  BSD3-style (as xmonad)
+--
+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout much like Tall, but using a multiple of a window's minimum
+-- resize amount instead of a percentage of screen to decide where to
+-- split. This is useful when you usually leave a text editor or
+-- terminal in the master pane and like it to be 80 columns wide.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.FixedColumn (
+    -- * Usage
+    -- $usage
+        FixedColumn(..)
+) where
+
+import Control.Monad (msum)
+import Data.Maybe (fromMaybe)
+import Graphics.X11.Xlib (Window, rect_width)
+import Graphics.X11.Xlib.Extras ( getWMNormalHints
+                                , getWindowAttributes
+                                , sh_base_size
+                                , sh_resize_inc
+                                , wa_border_width)
+
+import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)
+import XMonad.Layout (Resize(..), IncMasterN(..), tile)
+import XMonad.StackSet as W
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.FixedColumn
+--
+-- Then edit your @layoutHook@ by adding the FixedColumn layout:
+--
+-- > myLayout = FixedColumn 1 20 80 10 ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | A tiling mode based on preserving a nice fixed width
+--   window. Supports 'Shrink', 'Expand' and 'IncMasterN'.
+data FixedColumn a = FixedColumn !Int -- Number of windows in the master pane
+                                 !Int -- Number to increment by when resizing
+                                 !Int -- Default width of master pane
+                                 !Int -- Column width for normal windows
+                        deriving (Read, Show)
+
+instance LayoutClass FixedColumn Window where
+    doLayout (FixedColumn nmaster _ ncol fallback) r s = do
+            fws <- mapM (widthCols fallback ncol) ws
+            let frac = maximum (take nmaster fws) // rect_width r
+                rs   = tile frac r nmaster (length ws)
+            return $ (zip ws rs, Nothing)
+        where ws     = W.integrate s
+              x // y = fromIntegral x / fromIntegral y
+
+    pureMessage (FixedColumn nmaster delta ncol fallback) m =
+            msum [fmap resize     (fromMessage m)
+                 ,fmap incmastern (fromMessage m)]
+        where resize Shrink
+                  = FixedColumn nmaster delta (max 0 $ ncol - delta) fallback
+              resize Expand
+                  = FixedColumn nmaster delta (ncol + delta) fallback
+              incmastern (IncMasterN d)
+                  = FixedColumn (max 0 (nmaster+d)) delta ncol fallback
+
+    description _ = "FixedColumn"
+
+-- | Determine the width of @w@ given that we would like it to be @n@
+--   columns wide, using @inc@ as a resize increment for windows that
+--   don't have one
+widthCols :: Int -> Int -> Window -> X Int
+widthCols inc n w = withDisplay $ \d -> io $ do
+    sh <- getWMNormalHints d w
+    bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
+    let widthHint f = f sh >>= return . fromIntegral . fst
+        oneCol      = fromMaybe inc $ widthHint sh_resize_inc
+        base        = fromMaybe 0 $ widthHint sh_base_size
+    return $ 2 * bw + base + n * oneCol

XMonad/Layout/Gaps.hs

@@ -0,0 +1,144 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Gaps
+-- Copyright   :  (c) 2008 Brent Yorgey
+-- License     :  BSD3
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Create manually-sized gaps along edges of the screen which will not
+-- be used for tiling, along with support for toggling gaps on and
+-- off.
+--
+-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for
+-- leaving space for your dock-type applications (status bars,
+-- toolbars, docks, etc.), since it automatically sets up appropriate
+-- gaps, allows them to be toggled, etc.  However, this module may
+-- still be useful in some situations where the automated approach of
+-- ManageDocks does not work; for example, to work with a dock-type
+-- application that does not properly set the STRUTS property, or to
+-- leave part of the screen blank which is truncated by a projector,
+-- and so on.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Gaps (
+                               -- * Usage
+                               -- $usage
+                          Direction2D(..),
+                          GapSpec, gaps, GapMessage(..)
+
+                          ) where
+
+import XMonad.Core
+import Graphics.X11 (Rectangle(..))
+
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Types (Direction2D(..))
+
+import Data.List (delete)
+
+-- $usage
+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Layout.Gaps
+--
+-- and applying the 'gaps' modifier to your layouts as follows (for
+-- example):
+--
+-- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full  -- leave gaps at the top and right
+--
+-- You can additionally add some keybindings to toggle or modify the gaps,
+-- for example:
+--
+-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps)  -- toggle all gaps
+-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
+-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap R 5)  -- increment the right-hand gap
+-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap R 5)  -- decrement the right-hand gap
+--
+-- If you want complete control over all gaps, you could include
+-- something like this in your keybindings, assuming in this case you
+-- are using 'XMonad.Util.EZConfig.mkKeymap' or
+-- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig"
+-- for string keybinding specifications:
+--
+-- > ++
+-- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d)
+-- >     | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)]
+-- >     , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)]
+-- > ]
+--
+-- Given the above keybinding definition, for example, you could type
+-- @M-g, v, a@ to toggle the top gap.
+--
+-- To configure gaps differently per-screen, use
+-- "XMonad.Layout.PerScreen" (coming soon).
+
+-- | A manual gap configuration.  Each side of the screen on which a
+--   gap is enabled is paired with a size in pixels.
+type GapSpec = [(Direction2D,Int)]
+
+-- | The gap state.  The first component is the configuration (which
+--   gaps are allowed, and their current size), the second is the gaps
+--   which are currently active.
+data Gaps a = Gaps GapSpec [Direction2D]
+  deriving (Show, Read)
+
+-- | Messages which can be sent to a gap modifier.
+data GapMessage = ToggleGaps              -- ^ Toggle all gaps.
+                | ToggleGap  !Direction2D    -- ^ Toggle a single gap.
+                | IncGap !Int !Direction2D    -- ^ Increase a gap by a certain number of pixels.
+                | DecGap !Int !Direction2D    -- ^ Decrease a gap.
+  deriving (Typeable)
+
+instance Message GapMessage
+
+instance LayoutModifier Gaps a where
+    modifyLayout g w r = runLayout w (applyGaps g r)
+
+    pureMess (Gaps conf cur) m
+      | Just ToggleGaps    <- fromMessage m
+        = Just $ Gaps conf (toggleGaps conf cur)
+      | Just (ToggleGap d) <- fromMessage m
+        = Just $ Gaps conf (toggleGap conf cur d)
+      | Just (IncGap i d)  <- fromMessage m
+        = Just $ Gaps (incGap conf d i) cur
+      | Just (DecGap i d)  <- fromMessage m
+        = Just $ Gaps (incGap conf d (-i)) cur
+      | otherwise = Nothing
+
+applyGaps :: Gaps a -> Rectangle -> Rectangle
+applyGaps gs r = foldr applyGap r (activeGaps gs)
+  where
+    applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z)
+    applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z)
+    applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h
+    applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h
+
+activeGaps :: Gaps a -> GapSpec
+activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf
+
+toggleGaps :: GapSpec -> [Direction2D] -> [Direction2D]
+toggleGaps conf [] = map fst conf
+toggleGaps _    _  = []
+
+toggleGap :: GapSpec -> [Direction2D] -> Direction2D -> [Direction2D]
+toggleGap conf cur d | d `elem` cur            = delete d cur
+                     | d `elem` (map fst conf) = d:cur
+                     | otherwise               = cur
+
+incGap :: GapSpec -> Direction2D -> Int -> GapSpec
+incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
+
+fi :: (Num b, Integral a) => a -> b
+fi = fromIntegral
+
+-- | Add togglable manual gaps to a layout.
+gaps :: GapSpec   -- ^ The gaps to allow, paired with their initial sizes.
+     -> l a       -- ^ The layout to modify.
+     -> ModifiedLayout Gaps l a
+gaps g = ModifiedLayout (Gaps g (map fst g))
+

XMonad/Layout/Grid.hs

@@ -17,7 +17,7 @@
 module XMonad.Layout.Grid (
     -- * Usage
     -- $usage
-	Grid(..)
+    Grid(..), arrange, defaultRatio
 ) where
 
 import XMonad
@@ -30,37 +30,47 @@ import XMonad.StackSet
 --
 -- Then edit your @layoutHook@ by adding the Grid layout:
 --
--- > myLayouts = Grid ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = Grid ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- You can also specify an aspect ratio for Grid to strive for with the
+-- GridRatio constructor.  For example, if you want Grid to try to make a grid
+-- four windows wide and three windows tall, you could use
+--
+-- > myLayout = GridRatio (4/3) ||| etc.
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-data Grid a = Grid deriving (Read, Show)
+data Grid a = Grid | GridRatio Double deriving (Read, Show)
+
+defaultRatio :: Double
+defaultRatio = 16/9
 
 instance LayoutClass Grid a where
-    pureLayout Grid r s = arrange r (integrate s)
+    pureLayout Grid          r = pureLayout (GridRatio defaultRatio) r
+    pureLayout (GridRatio d) r = arrange d r . integrate
 
-arrange :: Rectangle -> [a] -> [(a, Rectangle)]
-arrange (Rectangle rx ry rw rh) st = zip st rectangles
+arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)]
+arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles
+    where
+    nwins = length st
+    ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
+    mincs = max 1 $ nwins `div` ncols
+    extrs = nwins - ncols * mincs
+    chop :: Int -> Dimension -> [(Position, Dimension)]
+    chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
         where
-        nwins = length st
-        ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins
-        mincs = nwins `div` ncols
-        extrs = nwins - ncols * mincs
-        chop :: Int -> Dimension -> [(Position, Dimension)]
-        chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
-                where
-                k :: Dimension
-                k = m `div` fromIntegral n
-                m' = fromIntegral m
-                k' :: Position
-                k' = fromIntegral k
-        xcoords = chop ncols rw
-        ycoords = chop mincs rh
-        ycoords' = chop (succ mincs) rh
-        (xbase, xext) = splitAt (ncols - extrs) xcoords
-        rectangles = combine ycoords xbase ++ combine ycoords' xext
-                where
-                combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]
+        k :: Dimension
+        k = m `div` fromIntegral n
+        m' = fromIntegral m
+        k' :: Position
+        k' = fromIntegral k
+    xcoords = chop ncols rw
+    ycoords = chop mincs rh
+    ycoords' = chop (succ mincs) rh
+    (xbase, xext) = splitAt (ncols - extrs) xcoords
+    rectangles = combine ycoords xbase ++ combine ycoords' xext
+        where
+        combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]

XMonad/Layout/GridVariants.hs

@@ -0,0 +1,224 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Layout.GridVariants
+-- Copyright   : (c) Norbert Zeh
+-- License     : BSD-style (see LICENSE)
+--
+-- Maintainer  : nzeh@cs.dal.ca
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Two layouts: one is a variant of the Grid layout that allows the
+-- desired aspect ratio of windows to be specified.  The other is like
+-- Tall but places a grid with fixed number of rows and columns in the
+-- master area and uses an aspect-ratio-specified layout for the
+-- slaves.
+----------------------------------------------------------------------
+
+module XMonad.Layout.GridVariants ( -- * Usage
+                                    -- $usage
+                                    ChangeMasterGeom(..)
+                                  , Grid(..)
+                                  , TallGrid(..)
+                                  , SplitGrid(..)
+                                  , Orientation(..)
+                                  ) where
+
+import Control.Monad
+import XMonad
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module can be used as follows:
+--
+-- > import XMonad.Layout.GridVariants
+--
+-- Then add something like this to your layouts:
+--
+-- > Grid (16/10)
+--
+-- for a 16:10 aspect ratio grid, or
+--
+-- > SplitGrid L 2 3 (2/3) (16/10) (5/100)
+--
+-- for a layout with a 2x3 master grid that uses 2/3 of the screen,
+-- and a 16:10 aspect ratio slave grid to its right.  The last
+-- parameter is again the percentage by which the split between master
+-- and slave area changes in response to Expand/Shrink messages.
+--
+-- To be able to change the geometry of the master grid, add something
+-- like this to your keybindings:
+--
+-- > ((modm .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1),
+-- > ((modm .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)),
+-- > ((modm .|. controlMask,  xK_equal), sendMessage $ IncMasterRows 1),
+-- > ((modm .|. controlMask,  xK_minus), sendMessage $ IncMasterRows (-1))
+
+-- | Grid layout.  The parameter is the desired x:y aspect ratio of windows
+data Grid a = Grid !Rational
+              deriving (Read, Show)
+
+instance LayoutClass Grid a where
+
+    pureLayout (Grid aspect) rect st = zip wins rects
+        where
+          wins  = W.integrate st
+          nwins = length wins
+          rects = arrangeAspectGrid rect nwins aspect
+
+    description _ = "Grid"
+
+-- | SplitGrid layout.  Parameters are
+--
+--   - side where the master is
+--   - number of master rows
+--   - number of master columns
+--   - portion of screen used for master grid
+--   - x:y aspect ratio of slave windows
+--   - increment for resize messages
+data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational
+                   deriving (Read, Show)
+
+-- | Type to specify the side of the screen that holds
+--   the master area of a SplitGrid.
+data Orientation = T | B | L | R
+                   deriving (Eq, Read, Show)
+
+instance LayoutClass SplitGrid a where
+
+    pureLayout (SplitGrid o mrows mcols mfrac saspect _) rect st = zip wins rects
+        where
+          wins  = W.integrate st
+          nwins = length wins
+          rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect
+
+    pureMessage layout msg =
+        msum [ fmap (resizeMaster layout) (fromMessage msg)
+             , fmap (changeMasterGrid layout) (fromMessage msg) ]
+
+    description _ = "SplitGrid"
+
+-- |The geometry change message understood by the master grid
+data ChangeMasterGeom
+    = IncMasterRows !Int -- ^Change the number of master rows
+    | IncMasterCols !Int -- ^Change the number of master columns
+    deriving Typeable
+
+instance Message ChangeMasterGeom
+
+arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle]
+arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect
+    | nwins <= mwins = arrangeMasterGrid rect nwins mcols
+    | mwins == 0     = arrangeAspectGrid rect nwins saspect
+    | otherwise      = (arrangeMasterGrid mrect mwins mcols) ++
+                       (arrangeAspectGrid srect swins saspect)
+    where
+      mwins            = mrows * mcols
+      swins            = nwins - mwins
+      mrect            = Rectangle mx my mw mh
+      srect            = Rectangle sx sy sw sh
+      (mh, sh, mw, sw) = if o `elem` [T, B] then
+                             (ceiling (fromIntegral rh * mfrac), rh - mh, rw, rw)
+                         else
+                             (rh, rh, ceiling (fromIntegral rw * mfrac), rw - mw)
+      mx               = fromIntegral rx + if o == R then fromIntegral sw else 0
+      my               = fromIntegral ry + if o == B then fromIntegral sh else 0
+      sx               = fromIntegral rx + if o == L then fromIntegral mw else 0
+      sy               = fromIntegral ry + if o == T then fromIntegral mh else 0
+
+arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle]
+arrangeMasterGrid rect nwins mcols = arrangeGrid rect nwins (min nwins mcols)
+
+arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle]
+arrangeAspectGrid rect@(Rectangle _ _ rw rh) nwins aspect =
+    arrangeGrid rect nwins (min nwins ncols)
+    where
+      scr_a = fromIntegral rw / fromIntegral rh
+      fcols = sqrt ( fromRational $ scr_a * fromIntegral nwins / aspect ) :: Double
+      cols1 = floor fcols :: Int
+      cols2 = ceiling fcols :: Int
+      rows1 = ceiling ( fromIntegral nwins / fromIntegral cols1 :: Rational ) :: Int
+      rows2 = floor ( fromIntegral nwins / fromIntegral cols2 :: Rational ) :: Int
+      a1    = scr_a * fromIntegral rows1 / fromIntegral cols1
+      a2    = scr_a * fromIntegral rows2 / fromIntegral cols2
+      ncols | cols1 == 0                = cols2
+            | rows2 == 0                = cols1
+            | a1 / aspect < aspect / a2 = cols1
+            | otherwise                 = cols2
+
+arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle]
+arrangeGrid (Rectangle rx ry rw rh) nwins ncols =
+    [Rectangle (fromIntegral x + rx) (fromIntegral y + ry) (fromIntegral w) (fromIntegral h)
+     | (x, y, w, h) <- rects]
+    where
+      nrows_in_cols = listDifference $ splitEvenly nwins ncols
+      x_slabs       = splitIntoSlabs (fromIntegral rw) ncols
+      y_slabs       = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols]
+      rects_in_cols = [[(x, y, w, h) | (y, h) <- lst]
+                       | ((x, w), lst) <- zip x_slabs y_slabs]
+      rects         = foldr (++) [] rects_in_cols
+
+splitIntoSlabs :: Int -> Int -> [(Int, Int)]
+splitIntoSlabs width nslabs = zip (0:xs) widths
+    where
+      xs = splitEvenly width nslabs
+      widths = listDifference xs
+
+listDifference :: [Int] -> [Int]
+listDifference lst = [cur-pre | (cur,pre) <- zip lst (0:lst)]
+
+splitEvenly :: Int -> Int -> [Int]
+splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets]
+    where
+      size    = ceiling ( (fromIntegral n / fromIntegral parts) :: Double )
+      extra   = size*parts - n
+      sizes   = [i*size | i <- [1..parts]]
+      offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..]
+
+resizeMaster :: SplitGrid a -> Resize -> SplitGrid a
+resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink =
+    SplitGrid o mrows mcols (max 0 (mfrac - delta)) saspect delta
+resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand =
+    SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta
+
+changeMasterGrid :: SplitGrid a -> ChangeMasterGeom -> SplitGrid a
+changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) =
+    SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta
+changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) =
+    SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta
+
+-- | TallGrid layout.  Parameters are
+--
+--   - number of master rows
+--   - number of master columns
+--   - portion of screen used for master grid
+--   - x:y aspect ratio of slave windows
+--   - increment for resize messages
+--
+--   This exists mostly because it was introduced in an earlier version.
+--   It's a fairly thin wrapper around "SplitGrid L".
+data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational
+                  deriving (Read, Show)
+
+instance LayoutClass TallGrid a where
+
+    pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects
+        where
+          wins  = W.integrate st
+          nwins = length wins
+          rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect
+
+    pureMessage layout msg =
+        msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg)
+             , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ]
+
+    description _ = "TallGrid"
+
+tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a
+tallGridAdapter f (TallGrid mrows mcols mfrac saspect delta) msg =
+    TallGrid mrows' mcols' mfrac' saspect' delta'
+    where
+      SplitGrid _ mrows' mcols' mfrac' saspect' delta' =
+          f (SplitGrid L mrows mcols mfrac saspect delta) msg

XMonad/Layout/HintedGrid.hs

@@ -0,0 +1,125 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.HintedGrid
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A not so simple layout that attempts to put all windows in a square grid
+-- while obeying their size hints.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.HintedGrid (
+    -- * Usage
+    -- $usage
+    Grid(..), arrange, defaultRatio
+) where
+
+import Prelude hiding ((.))
+
+import XMonad
+import XMonad.StackSet
+
+import Control.Monad.State
+import Data.List
+import Data.Ord
+
+infixr 9 .
+(.) :: (Functor f) => (a -> b) -> f a -> f b
+(.) = fmap
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.HintedGrid
+--
+-- Then edit your @layoutHook@ by adding the 'Grid' layout:
+--
+-- > myLayout = Grid False ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- You can also specify an aspect ratio for Grid to strive for with the
+-- GridRatio constructor:
+--
+-- > myLayout = GridRatio (4/3) False ||| etc.
+--
+-- For more detailed instructions on editing the layoutHook see
+-- "XMonad.Doc.Extending#Editing_the_layout_hook".
+
+-- | Automatic mirroring of hinted layouts doesn't work very well, so this
+-- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout,
+-- @Grid True@ is the mirrored variant (rotated by 90 degrees).
+data Grid a = Grid Bool | GridRatio Double Bool deriving (Read, Show)
+
+defaultRatio :: Double
+defaultRatio = 16/9
+
+instance LayoutClass Grid Window where
+    doLayout (Grid m)        r w = doLayout (GridRatio defaultRatio m) r w
+    doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w)
+
+replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
+replicateS n = runState . replicateM n . State
+
+doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D]
+doColumn width height k adjs =
+    let
+        (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs
+        (_, ds) = doC height k fs
+    in
+    map snd . sortBy (comparing fst) . zip ind $ ds
+    where
+    doC h _ [] = (h, [])
+    doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs
+        where
+        adj@(_, h') = f (width, h `div` n)
+
+doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]
+doRect height = doR
+    where
+    doR _ _ [] = []
+    doR width n (c : cs) =
+        let
+            v = fromIntegral $ length c
+            c' = doColumn (width `div` n) height v c
+            (ws, hs) = unzip c'
+            maxw = maximum ws
+            height' = sum hs
+            hbonus = height - height'
+            hsingle = hbonus `div` v
+            hoffset = hsingle `div` 2
+            width' = width - maxw
+            ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs
+            xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws
+        in
+        zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs
+
+-- | The internal function for computing the grid layout.
+arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]
+arrange aspectRatio mirror (Rectangle rx ry rw rh) wins = do
+    proto <- mapM mkAdjust wins
+    let
+        adjs = map (\f -> twist . f . twist) proto
+        rs = arrange' aspectRatio (twist (rw, rh)) adjs
+        rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs
+    return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs'
+    where
+    twist
+        | mirror = \(a, b) -> (b, a)
+        | otherwise = id
+
+arrange' :: Double -> D -> [D -> D] -> [Rectangle]
+arrange' aspectRatio (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols)
+    where
+    nwindows = length adjs
+    ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh * aspectRatio)
+    nrows = nwindows `div` ncolumns
+    nextras = nwindows - ncolumns * nrows
+    (ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs
+    (cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs'

XMonad/Layout/HintedTile.hs

@@ -16,13 +16,13 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Layout.HintedTile (
-                                 -- * Usage
-                                 -- $usage
-                                 HintedTile(..), Orientation(..)) where
+    -- * Usage
+    -- $usage
+    HintedTile(..), Orientation(..), Alignment(..)
+) where
 
 import XMonad hiding (Tall(..))
 import qualified XMonad.StackSet as W
-import Control.Applicative ((<$>))
 import Control.Monad
 
 -- $usage
@@ -32,31 +32,50 @@ import Control.Monad
 --
 -- Then edit your @layoutHook@ by adding the HintedTile layout:
 --
--- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc..
+-- >   where
+-- >      hintedTile = HintedTile nmaster delta ratio TopLeft
+-- >      nmaster    = 1
+-- >      ratio      = 1/2
+-- >      delta      = 3/100
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall,
+-- you need to disambiguate Tall. If you are replacing the
+-- built-in Tall with HintedTile, change @import Xmonad@ to
+-- @import Xmonad hiding (Tall)@.
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 data HintedTile a = HintedTile
-    { nmaster     :: Int
-    , delta, frac :: Rational
-    , orientation :: Orientation
+    { nmaster     :: !Int         -- ^ number of windows in the master pane
+    , delta       :: !Rational    -- ^ how much to change when resizing
+    , frac        :: !Rational    -- ^ ratio between master/nonmaster panes
+    , alignment   :: !Alignment   -- ^ Where to place windows that are smaller
+                                  --   than their preordained rectangles.
+    , orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout?
     } deriving ( Show, Read )
 
-data Orientation = Wide | Tall deriving ( Show, Read )
+data Orientation
+     = Wide -- ^ Lay out windows similarly to Mirror tiled.
+     | Tall -- ^ Lay out windows similarly to tiled.
+    deriving ( Show, Read, Eq, Ord )
+
+data Alignment = TopLeft | Center | BottomRight
+    deriving ( Show, Read, Eq, Ord )
 
 instance LayoutClass HintedTile Window where
-    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do
-        bhs <- mapM getHints w
+    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do
+        bhs <- mapM mkAdjust w
         let (masters, slaves) = splitAt nm bhs
         return (zip w (tiler masters slaves), Nothing)
      where
         w = W.integrate w'
         tiler masters slaves
-            | null masters || null slaves = divide o (masters ++ slaves) r
-            | otherwise = split o f r (divide o masters) (divide o slaves)
+            | null masters || null slaves = divide al o (masters ++ slaves) r
+            | otherwise = split o f r (divide al o masters) (divide al o slaves)
 
     pureMessage c m = fmap resize     (fromMessage m) `mplus`
                       fmap incmastern (fromMessage m)
@@ -67,29 +86,27 @@ instance LayoutClass HintedTile Window where
 
     description l = show (orientation l)
 
-adjBorder :: Dimension -> Dimension -> D -> D
-adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b)
-
--- | Transform a function on dimensions into one without regard for borders
-hintsUnderBorder :: (Dimension, SizeHints) -> D -> D
-hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1)
-
-getHints :: Window -> X (Dimension, SizeHints)
-getHints w = withDisplay $ \d -> io $ liftM2 (,)
-    (fromIntegral . wa_border_width <$> getWindowAttributes d w)
-    (getWMNormalHints d w)
+align :: Alignment -> Position -> Dimension -> Dimension -> Position
+align TopLeft     p _ _ = p
+align Center      p a b = p + fromIntegral (a - b) `div` 2
+align BottomRight p a b = p + fromIntegral (a - b)
 
 -- Divide the screen vertically (horizontally) into n subrectangles
-divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle]
-divide _ [] _ = []
-divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
- where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs)))
+divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]
+divide _ _ [] _ = []
+divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h]
+    where
+    (w, h) = bh (sw, sh)
 
-divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divide Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
+divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) :
+      (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
  where
-    (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh)
+    (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs)))
+
+divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) :
+      (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
+ where
+    (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh)
 
 -- Split the screen into two rectangles, using a rational to specify the ratio
 split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])

XMonad/Layout/IM.hs

@@ -0,0 +1,127 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.IM
+-- Copyright   :  (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Layout modfier suitable for workspace with multi-windowed instant messenger
+-- (like Psi or Tkabber).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.IM (
+    -- * Usage
+    -- $usage
+
+    -- * Hints
+    -- $hints
+
+    -- * TODO
+    -- $todo
+        Property(..), IM(..), withIM, gridIM,
+) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import Data.List
+import XMonad.Layout (splitHorizontallyBy)
+import XMonad.Layout.Grid
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.WindowProperties
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.IM
+-- > import Data.Ratio ((%))
+--
+-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer
+-- for managing your chat windows (Grid in this example, another useful choice
+-- to consider is Tabbed layout).
+--
+-- > myLayout = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- Here @1%7@ is the part of the screen which your roster will occupy,
+-- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster.
+--
+-- Screenshot: <http://haskell.org/haskellwiki/Image:Xmonad-layout-im.png>
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- $hints
+--
+-- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace".
+--
+-- By default the roster window will appear on the left side.
+-- To place roster window on the right side, use @reflectHoriz@ from
+-- "XMonad.Layout.Reflect" module.
+
+-- $todo
+-- This item are questionable. Please let me know if you find them useful.
+--
+-- * shrink\/expand
+--
+
+-- | Data type for LayoutModifier which converts given layout to IM-layout
+-- (with dedicated space for the roster and original layout for chat windows)
+data AddRoster a = AddRoster Rational Property deriving (Read, Show)
+
+instance LayoutModifier AddRoster Window where
+  modifyLayout (AddRoster ratio prop) = applyIM ratio prop
+  modifierDescription _                = "IM"
+
+-- | Modifier which converts given layout to IM-layout (with dedicated
+-- space for roster and original layout for chat windows)
+withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a
+withIM ratio prop = ModifiedLayout $ AddRoster ratio prop
+
+-- | IM layout modifier applied to the Grid layout
+gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a
+gridIM ratio prop = withIM ratio prop Grid
+
+-- | Internal function for adding space for the roster specified by
+-- the property and running original layout for all chat windows
+applyIM :: (LayoutClass l Window) =>
+               Rational
+            -> Property
+            -> S.Workspace WorkspaceId (l Window) Window
+            -> Rectangle
+            -> X ([(Window, Rectangle)], Maybe (l Window))
+applyIM ratio prop wksp rect = do
+    let stack = S.stack wksp
+    let ws = S.integrate' $ stack
+    let (masterRect, slaveRect) = splitHorizontallyBy ratio rect
+    master <- findM (hasProperty prop) ws
+    case master of
+        Just w -> do
+            let filteredStack = stack >>= S.filter (w /=)
+            wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect
+            return ((w, masterRect) : fst wrs, snd wrs)
+        Nothing -> runLayout wksp rect
+
+-- | Like find, but works with monadic computation instead of pure function.
+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
+findM _ [] = return Nothing
+findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }
+
+-- | This is for compatibility with old configs only and will be removed in future versions!
+data IM a = IM Rational Property deriving (Read, Show)
+instance LayoutClass IM Window where
+    description _ = "IM"
+    doLayout (IM r prop) rect stack = do
+        let ws = S.integrate stack
+        let (masterRect, slaveRect) = splitHorizontallyBy r rect
+        master <- findM (hasProperty prop) ws
+        let positions = case master of
+                Just w -> (w, masterRect) : arrange defaultRatio slaveRect (filter (w /=) ws)
+                Nothing -> arrange defaultRatio rect ws
+        return (positions, Nothing)