Export types to improve haddock links.

Added new messages the layout understands to allow changing the grid aspect
ratio and setting the fraction of the master to a given value rather than
changing it relative to the current value.

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/BluetileCommands.hs

@@ -0,0 +1,83 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.BluetileCommands
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This is a list of selected commands that can be made available using
+-- "XMonad.Hooks.ServerMode" to allow external programs to control
+-- the window manager. Bluetile (<http://projects.haskell.org/bluetile/>)
+-- uses this to enable its dock application to do things like changing
+-- workspaces and layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.BluetileCommands (
+    -- * Usage
+    -- $usage
+    bluetileCommands
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutCombinators
+import System.Exit
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Hooks.ServerMode
+-- >    import XMonad.Actions.BluetileCommands
+--
+-- Then edit your @handleEventHook@:
+--
+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands }
+--
+-- See the documentation of "XMonad.Hooks.ServerMode" for details on
+-- how to actually invoke the commands from external programs.
+
+workspaceCommands :: Int -> X [(String, X ())]
+workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
+                            [(("greedyView" ++ show i),
+                                activateScreen sid >> windows (W.greedyView i))
+                                | i <- spaces ]
+
+layoutCommands :: Int -> [(String, X ())]
+layoutCommands sid = [ ("layout floating"    , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Floating"))
+                     , ("layout tiled1"      , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Tiled1"))
+                     , ("layout tiled2"      , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Tiled2"))
+                     , ("layout fullscreen"  , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Fullscreen"))
+                     ]
+
+masterAreaCommands :: Int -> [(String, X ())]
+masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
+                                                    sendMessage (IncMasterN 1))
+                         , ("decrease master n", activateScreen sid >>
+                                                    sendMessage (IncMasterN (-1)))
+                         ]
+
+quitCommands :: [(String, X ())]
+quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
+               , ("quit bluetile and start metacity", restart "metacity" False)
+               ]
+
+bluetileCommands :: X [(String, X ())]
+bluetileCommands = do
+    let restartCommand = [ ("restart bluetile", restart "bluetile" True) ]
+    wscmds0 <- workspaceCommands 0
+    wscmds1 <- workspaceCommands 1
+    return $ restartCommand
+                ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands
+                ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands
+
+activateScreen :: Int -> X ()
+activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view)

XMonad/Actions/Commands.hs

@@ -41,7 +41,7 @@ import Data.Maybe
 --
 -- Then add a keybinding to the runCommand action:
 --
--- >    , ((modMask x .|. controlMask, xK_y), commands >>= runCommand)
+-- >    , ((modm .|. controlMask, xK_y), commands >>= runCommand)
 --
 -- and define the list of commands you want to use:
 --
@@ -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 "xmonad" True                       )
-        , ("restart-wm-no-resume", sr >> restart "xmonad" 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
@@ -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

@@ -2,14 +2,14 @@
 -----------------------------------------------------------------------------
 -- |
 -- 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,19 @@
 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 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 +42,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 +54,112 @@ 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 = viewing wid $ W.modify Nothing (W.filter (/= w))
+
+      viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
+
+-- | 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

@@ -25,12 +25,12 @@ 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
 --
--- >   , ((modMask x,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])
+-- >   , ((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.

XMonad/Actions/CycleWS.hs

@@ -42,7 +42,12 @@ module XMonad.Actions.CycleWS (
                               , prevWS
                               , shiftToNext
                               , shiftToPrev
+
+                                -- * Toggling the previous workspace
+                                -- $toggling
                               , toggleWS
+                              , toggleWS'
+                              , toggleOrView
 
                                 -- * Moving between screens (xinerama)
 
@@ -56,23 +61,30 @@ module XMonad.Actions.CycleWS (
                                 -- * Moving between workspaces, take two!
                                 -- $taketwo
 
-                              , WSDirection(..)
+                              , Direction1D(..)
                               , WSType(..)
 
                               , shiftTo
                               , moveTo
+                              , doTo
 
                                 -- * The mother-combinator
 
                               , findWorkspace
+                              , toggleOrDoSkip
+                              , skipTags
+
+                              , screenBy
 
                              ) where
 
+import Control.Monad ( unless )
 import Data.List ( findIndex )
 import Data.Maybe ( isNothing, isJust )
 
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter)
+import XMonad.Util.Types
 import XMonad.Util.WorkspaceCompare
 
 -- $usage
@@ -82,27 +94,27 @@ import XMonad.Util.WorkspaceCompare
 -- >
 -- > -- a basic CycleWS setup
 -- >
--- >   , ((modMask x,               xK_Down),  nextWS)
--- >   , ((modMask x,               xK_Up),    prevWS)
--- >   , ((modMask x .|. shiftMask, xK_Down),  shiftToNext)
--- >   , ((modMask x .|. shiftMask, xK_Up),    shiftToPrev)
--- >   , ((modMask x,               xK_Right), nextScreen)
--- >   , ((modMask x,               xK_Left),  prevScreen)
--- >   , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen)
--- >   , ((modMask x .|. shiftMask, xK_Left),  shiftPrevScreen)
--- >   , ((modMask x,               xK_z),     toggleWS)
+-- >   , ((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_Down), shiftToNext >> nextWS)
--- >   , ((modMask x .|. shiftMask, xK_Up),   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:
 --
--- >   , ((modMask x     , xK_f), moveTo Next EmptyWS)  -- find a free workspace
--- >   , ((modMask x .|. controlMask, xK_Right),        -- a crazy keybinding!
--- >         do t <- findWorkspace getXineramaWsCompare Next NonEmptyWS 2
+-- >   , ((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
@@ -135,9 +147,56 @@ shiftToNext = shiftBy 1
 shiftToPrev :: X ()
 shiftToPrev = shiftBy (-1)
 
+-- $toggling
+
 -- | Toggle to the workspace displayed previously.
 toggleWS :: X ()
-toggleWS = windows $ view =<< tag . head . hidden
+toggleWS = toggleWS' []
+
+-- | Toggle to the previous workspace while excluding some workspaces.
+--
+-- > -- Ignore the scratchpad workspace while toggling:
+-- > ("M-b", toggleWS' ["NSP"])
+toggleWS' :: [WorkspaceId] -> X ()
+toggleWS' skips = do
+    hs' <- cleanHiddens skips
+    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\"), and
+-- running other actions such as 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
+    hs' <- cleanHiddens skips
+    cur <- gets (currentTag . windowset)
+    if toWS == cur
+        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
+
+cleanHiddens :: [WorkspaceId] -> X [WindowSpace]
+cleanHiddens skips =  gets $ (flip skipTags) skips . hidden . windowset
 
 switchWorkspace :: Int -> X ()
 switchWorkspace d = wsBy d >>= windows . greedyView
@@ -166,14 +225,16 @@ the letter 'p' in its name. =)
 
 -}
 
--- | Direction to cycle through the sort order.
-data WSDirection = Next | Prev
-
 -- | 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
+            | WSTagGroup Char
+                          -- ^ cycle through workspaces in the same group, the
+                          --   group name is all characters up to the first
+                          --   separator character or the end of the tag
             | WSIs (X (WindowSpace -> Bool))
                           -- ^ cycle through workspaces satisfying
                           --   an arbitrary predicate
@@ -182,20 +243,31 @@ data WSType = EmptyWS     -- ^ cycle through empty workspaces
 wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
 wsTypeToPred EmptyWS    = return (isNothing . stack)
 wsTypeToPred NonEmptyWS = return (isJust . stack)
-wsTypeToPred HiddenNonEmptyWS = do hs <- gets (map tag . hidden . windowset)
-                                   return (\w -> isJust (stack w) && tag w `elem` hs)
+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 (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
+                                   return $ (cur ==).groupName
+                                   where groupName = takeWhile (/=sep).tag
 wsTypeToPred (WSIs p)   = p
 
 -- | View the next workspace in the given direction that satisfies
 --   the given condition.
-moveTo :: WSDirection -> WSType -> X ()
-moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
+moveTo :: Direction1D -> WSType -> X ()
+moveTo dir t = doTo dir t getSortByIndex (windows . greedyView)
 
 -- | Move the currently focused window to the next workspace in the
 --   given direction that satisfies the given condition.
-shiftTo :: WSDirection -> WSType -> X ()
-shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
+shiftTo :: Direction1D -> WSType -> X ()
+shiftTo dir t = doTo dir t getSortByIndex (windows . shift)
+
+-- | Using the given sort, find the next workspace in the given
+-- direction of the given type, and perform the given action on it.
+doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
+doTo dir t srt act = findWorkspace srt dir t 1 >>= act
 
 -- | Given a function @s@ to sort workspaces, a direction @dir@, a
 --   predicate @p@ on workspaces, and an integer @n@, find the tag of
@@ -210,14 +282,14 @@ shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
 --   that 'moveTo' and 'shiftTo' are implemented by applying @(>>=
 --   (windows . greedyView))@ and @(>>= (windows . shift))@, respectively,
 --   to the output of 'findWorkspace'.
-findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId
+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 = (tag . workspace . current) `fmap` gets windowset
+findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
 findWorkspaceGen sortX wsPredX d = do
     wsPred <- wsPredX
     sort   <- sortX
@@ -225,7 +297,7 @@ findWorkspaceGen sortX wsPredX d = do
     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
+        ws'     = filter wsPred pivoted
         mCurIx  = findWsIndex cur ws'
         d'      = if d > 0 then d - 1 else d
         next    = if null ws'
@@ -253,6 +325,17 @@ switchScreen d = do s <- screenBy d
                          Nothing -> return ()
                          Just ws -> windows (view ws)
 
+{- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the
+the default screen keybindings:
+
+>     -- mod-{w,e}, Switch to previous/next Xinerama screen
+>     -- mod-shift-{w,e}, Move client to previous/next Xinerama screen
+>     --
+>     [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f))
+>         | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)]
+>         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
+-}
 screenBy :: Int -> X (ScreenId)
 screenBy d = do ws <- gets windowset
                 --let ss = sortBy screen (screens ws)

XMonad/Actions/CycleWindows.hs

@@ -0,0 +1,235 @@
+--------------------------------------------------------------------------------
+-- |
+-- 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 such that @rotUp [1..4]@ is equivalent to
+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
+-- @id@ for null or singleton lists.
+rotUp :: [a] -> [a]
+rotUp   l = drop 1 l ++ take 1 l
+rotDown :: [a] -> [a]
+rotDown = reverse . rotUp . reverse

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/DynamicWorkspaceGroups.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceGroups
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Dynamically manage \"workspace groups\", sets of workspaces being
+-- used together for some common task or purpose, to allow switching
+-- between workspace groups in a single action.  Note that this only
+-- makes sense for multi-head setups.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceGroups
+    ( -- * Usage
+      -- $usage
+
+      WSGroupId
+
+    , addWSGroup
+    , addCurrentWSGroup
+    , forgetWSGroup
+    , viewWSGroup
+
+    , promptWSGroupView
+    , promptWSGroupAdd
+    , promptWSGroupForget
+
+    , WSGPrompt
+    ) where
+
+import Data.List (find)
+import Control.Arrow ((&&&))
+import qualified Data.Map as M
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Prompt
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Actions.DynamicWorkspaceGroups
+--
+-- Then add keybindings like the following (this example uses
+-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
+--
+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
+-- >    , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
+--
+
+type WSGroup = [(ScreenId,WorkspaceId)]
+
+type WSGroupId = String
+
+data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
+  deriving (Typeable, Read, Show)
+
+withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
+withWSG f = WSG . f . unWSG
+
+instance ExtensionClass WSGroupStorage where
+  initialValue = WSG $ M.empty
+  extensionType = PersistentExtension
+
+-- | Add a new workspace group with the given name.
+addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
+addWSGroup name wids = withWindowSet $ \w -> do
+  let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
+      wmap = mapM (strength . (flip lookup wss &&& id)) wids
+  case wmap of
+    Just ps -> XS.modify . withWSG . M.insert name $ ps
+    Nothing -> return ()
+ where strength (ma, b) = ma >>= \a -> return (a,b)
+
+-- | Give a name to the current workspace group.
+addCurrentWSGroup :: WSGroupId -> X ()
+addCurrentWSGroup name = withWindowSet $ \w ->
+  addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)
+
+-- | Delete the named workspace group from the list of workspace
+--   groups.  Note that this has no effect on the workspaces involved;
+--   it simply forgets the given name.
+forgetWSGroup :: WSGroupId -> X ()
+forgetWSGroup = XS.modify . withWSG . M.delete
+
+-- | View the workspace group with the given name.
+viewWSGroup :: WSGroupId -> X ()
+viewWSGroup name = do
+  WSG m <- XS.get
+  case M.lookup name m of
+    Just grp -> mapM_ (uncurry viewWS) grp
+    Nothing -> return ()
+
+-- | View the given workspace on the given screen.
+viewWS :: ScreenId -> WorkspaceId -> X ()
+viewWS sid wid = do
+  mw <- findScreenWS sid
+  case mw of
+    Just w -> do
+      windows $ W.view w
+      windows $ W.greedyView wid
+    Nothing -> return ()
+
+-- | Find the workspace which is currently on the given screen.
+findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
+findScreenWS sid = withWindowSet $
+  return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
+
+data WSGPrompt = WSGPrompt String
+
+instance XPrompt WSGPrompt where
+  showXPrompt (WSGPrompt s) = s
+
+-- | Prompt for a workspace group to view.
+promptWSGroupView :: XPConfig -> String -> X ()
+promptWSGroupView xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
+
+-- | Prompt for a name for the current workspace group.
+promptWSGroupAdd :: XPConfig -> String -> X ()
+promptWSGroupAdd xp s =
+  mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup
+
+-- | Prompt for a workspace group to forget.
+promptWSGroupForget :: XPConfig -> String -> X ()
+promptWSGroupForget xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceOrder
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Remember a dynamically updateable ordering on workspaces, together
+-- with tools for using this ordering with "XMonad.Actions.CycleWS"
+-- and "XMonad.Hooks.DynamicLog".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceOrder
+    ( -- * Usage
+      -- $usage
+
+      getWsCompareByOrder
+    , getSortByOrder
+    , swapWith
+
+    , moveTo
+    , moveToGreedy
+    , shiftTo
+
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Ord (comparing)
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
+--
+-- Then add keybindings to swap the order of workspaces (these
+-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
+--
+-- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)
+-- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)
+--
+-- See "XMonad.Actions.CycleWS" for information on the possible
+-- arguments to 'swapWith'.
+--
+-- However, by itself this will do nothing; 'swapWith' does not change
+-- the actual workspaces in any way.  It simply keeps track of an
+-- auxiliary ordering on workspaces.  Anything which cares about the
+-- order of workspaces must be updated to use the auxiliary ordering.
+--
+-- To change the order in which workspaces are displayed by
+-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
+-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
+--
+-- >   ... dynamicLogWithPP $ byorgeyPP {
+-- >     ...
+-- >     , ppSort = DO.getSortByOrder
+-- >     ...
+-- >   }
+--
+-- To use workspace cycling commands like those from
+-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
+-- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:
+--
+-- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)
+-- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)
+-- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)
+-- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)
+--
+-- For slight variations on these, use the source for examples and
+-- tweak as desired.
+
+-- | Extensible state storage for the workspace order.
+data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
+  deriving (Typeable, Read, Show)
+
+instance ExtensionClass WSOrderStorage where
+  initialValue = WSO Nothing
+  extensionType = PersistentExtension
+
+-- | Lift a Map function to a function on WSOrderStorage.
+withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
+           -> (WSOrderStorage -> WSOrderStorage)
+withWSO f = WSO . fmap f . unWSO
+
+-- | Update the ordering storage: initialize if it doesn't yet exist;
+-- add newly created workspaces at the end as necessary.
+updateOrder :: X ()
+updateOrder = do
+  WSO mm <- XS.get
+  case mm of
+    Nothing -> do
+      -- initialize using ordering of workspaces from the user's config
+      ws <- asks (workspaces . config)
+      XS.put . WSO . Just . M.fromList $ zip ws [0..]
+    Just m -> do
+      -- check for new workspaces and add them at the end
+      curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)
+      let mappedWs  = M.keysSet m
+          newWs     = curWs `S.difference` mappedWs
+          nextIndex = 1 + maximum (-1 : M.elems m)
+          newWsIxs  = zip (S.toAscList newWs) [nextIndex..]
+      XS.modify . withWSO . M.union . M.fromList $ newWsIxs
+
+-- | A comparison function which orders workspaces according to the
+-- stored dynamic ordering.
+getWsCompareByOrder :: X WorkspaceCompare
+getWsCompareByOrder = do
+  updateOrder
+  -- after the call to updateOrder we are guaranteed that the dynamic
+  -- workspace order is initialized and contains all existing
+  -- workspaces.
+  WSO (Just m) <- XS.get
+  return $ comparing (fromMaybe 1000 . flip M.lookup m)
+
+-- | Sort workspaces according to the stored dynamic ordering.
+getSortByOrder :: X WorkspaceSort
+getSortByOrder = mkWsSort getWsCompareByOrder
+
+-- | Swap the current workspace with another workspace in the stored
+-- dynamic order.
+swapWith :: Direction1D -> WSType -> X ()
+swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent
+
+-- | Swap the given workspace with the current one.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent w = do
+  cur <- gets (W.currentTag . windowset)
+  swapOrder w cur
+
+-- | Swap the two given workspaces in the dynamic order.
+swapOrder :: WorkspaceId -> WorkspaceId -> X ()
+swapOrder w1 w2 = do
+  io $ print (w1,w2)
+  WSO (Just m) <- XS.get
+  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
+  XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
+  windows id  -- force a status bar update
+
+-- | View the next workspace of the given type in the given direction,
+-- where \"next\" is determined using the dynamic workspace order.
+moveTo :: Direction1D -> WSType -> X ()
+moveTo dir t = doTo dir t getSortByOrder (windows . W.view)
+
+-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
+moveToGreedy :: Direction1D -> WSType -> X ()
+moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
+
+-- | Shift the currently focused window to the next workspace of the
+-- given type in the given direction, using the dynamic workspace order.
+shiftTo :: Direction1D -> WSType -> X ()
+shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)

XMonad/Actions/DynamicWorkspaces.hs

@@ -4,19 +4,23 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Provides bindings to add and delete workspaces.  Note that you may only
--- delete a workspace that is already empty.
+-- Provides bindings to add and delete workspaces.
 --
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.DynamicWorkspaces (
                                          -- * Usage
                                          -- $usage
-                                         addWorkspace, removeWorkspace,
+                                         addWorkspace, addWorkspacePrompt,
+                                         removeWorkspace,
+                                         removeEmptyWorkspace,
+                                         removeEmptyWorkspaceAfter,
+                                         removeEmptyWorkspaceAfterExcept,
+                                         addHiddenWorkspace,
                                          withWorkspace,
                                          selectWorkspace, renameWorkspace,
                                          toNthWorkspace, withNthWorkspace
@@ -24,39 +28,39 @@ module XMonad.Actions.DynamicWorkspaces (
 
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
-import XMonad.Prompt.Workspace
-import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
+import XMonad.Prompt ( XPConfig, mkXPrompt )
 import XMonad.Util.WorkspaceCompare ( getSortByIndex )
+import Data.List (find)
+import Data.Maybe (isNothing)
+import Control.Monad (when)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.DynamicWorkspaces
+-- > import XMonad.Actions.CopyWindow(copy)
 --
 -- 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".
+-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
+-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'defaultXPConfig'.
 
 
-data Wor = Wor String
-
-instance XPrompt Wor where
-    showXPrompt (Wor x) = x
-
 mkCompl :: [String] -> String -> IO [String]
 mkCompl l s = return $ filter (\x -> take (length s) x == s) l
 
@@ -96,23 +100,68 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
                             then windows $ greedyView w
                             else addWorkspace w
 
--- | Add a new workspace with the given name.
+-- | Add a new workspace with the given name, or do nothing if a
+--   workspace with the given name already exists; then switch to the
+--   newly created workspace.
 addWorkspace :: String -> X ()
 addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
 
+-- | Prompt for the name of a new workspace, add it if it does not
+--   already exist, and switch to it.
+addWorkspacePrompt :: XPConfig -> X ()
+addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace
+
+-- | Add a new hidden workspace with the given name, or do nothing if
+--   a workspace with the given name already exists.
 addHiddenWorkspace :: String -> X ()
-addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
-                               windows (addHiddenWorkspace' newtag l)
+addHiddenWorkspace newtag =
+  whenX (gets (not . tagMember newtag . windowset)) $ do
+    l <- asks (layoutHook . config)
+    windows (addHiddenWorkspace' newtag l)
 
 -- | Remove the current workspace if it contains no windows.
+removeEmptyWorkspace :: X ()
+removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag
+
+-- | Remove the current workspace.
 removeWorkspace :: X ()
-removeWorkspace = do s <- gets windowset
-                     case s of
-                       StackSet { current = Screen { workspace = torem }
-                                , hidden = (w:_) }
-                           -> do windows $ view (tag w)
-                                 windows (removeWorkspace' (tag torem))
-                       _ -> return ()
+removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
+
+-- | Remove workspace with specific tag if it contains no windows. Only works
+--   on the current or the last workspace.
+removeEmptyWorkspaceByTag :: String -> X ()
+removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t
+
+-- | Remove workspace with specific tag. Only works on the current or the last workspace.
+removeWorkspaceByTag :: String -> X ()
+removeWorkspaceByTag torem = do
+    s <- gets windowset
+    case s of
+        StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do
+                when (torem==tag cur) $ windows $ view $ tag w
+                windows $ removeWorkspace' torem
+        _ -> return ()
+
+-- | Remove the current workspace after an operation if it is empty and hidden.
+--   Can be used to remove a workspace if it is empty when leaving it. The
+--   operation may only change workspace once, otherwise the workspace will not
+--   be removed.
+removeEmptyWorkspaceAfter :: X () -> X ()
+removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
+
+-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
+--   whose entries will never be removed.
+removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
+removeEmptyWorkspaceAfterExcept sticky f = do
+    before <- gets (currentTag . windowset)
+    f
+    after <- gets (currentTag . windowset)
+    when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before
+
+isEmpty :: String -> X Bool
+isEmpty t = do wsl <- gets $ workspaces . windowset
+               let mws = find (\ws -> tag ws == t) wsl
+               return $ maybe True (isNothing . stack) mws
 
 addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
 addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }

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.
@@ -23,6 +23,8 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
+import qualified Prelude as P
+import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
 
 -- $usage
 -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@@ -31,7 +33,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.
@@ -84,7 +86,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
 
     let uv = (pointer - wpos) / wsize
         fc = mapP f uv
-        mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
+        mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
         atl = ((1, 1) - fc) * mul
         abr = fc * mul
     mouseDrag (\ex ey -> io $ do
@@ -92,7 +94,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)
@@ -121,14 +123,13 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
 minP :: Ord a => (a,a) -> (a,a) -> (a,a)
 minP = zipP min
 
-instance Num Pnt where
-    (+) = zipP (+)
-    (-) = zipP (-)
-    (*) = zipP (*)
-    abs = mapP abs
-    signum = mapP signum
-    fromInteger = const undefined
+infixl 6  +, -
+infixl 7  *, /
+
+(+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)
+(+) = zipP (P.+)
+(-) = zipP (P.-)
+(*) = zipP (P.*)
+(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
+(/) = zipP (P./)
 
-instance Fractional Pnt where
-    fromRational = const undefined
-    recip = mapP recip

XMonad/Actions/FlexibleResize.hs

@@ -15,10 +15,12 @@
 module XMonad.Actions.FlexibleResize (
         -- * Usage
         -- $usage
-        XMonad.Actions.FlexibleResize.mouseResizeWindow
+        XMonad.Actions.FlexibleResize.mouseResizeWindow,
+        XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow
 ) where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Foreign.C.Types
 
 -- $usage
@@ -28,40 +30,50 @@ 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)

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.
@@ -17,7 +17,9 @@ module XMonad.Actions.FloatKeys (
                 keysMoveWindow,
                 keysMoveWindowTo,
                 keysResizeWindow,
-                keysAbsResizeWindow) where
+                keysAbsResizeWindow,
+                P, G,
+                ) where
 
 import XMonad
 
@@ -28,11 +30,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 +96,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 +105,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

XMonad/Actions/GridSelect.hs

@@ -0,0 +1,698 @@
+{-# 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,
+    TwoDPosition,
+    buildDefaultGSConfig,
+
+    -- * Variations on 'gridselect'
+    gridselect,
+    gridselectWindow,
+    withSelectedWindow,
+    bringSelected,
+    goToSelected,
+    gridselectWorkspace,
+    spawnSelected,
+    runSelectedAction,
+
+    -- * Colorizers
+    HasColorizer(defaultColorizer),
+    fromClassName,
+    stringColorizer,
+    colorRangeFromClassName,
+
+    -- * Navigation Mode assembly
+    TwoD,
+    makeXEventhandler,
+    shadowWithKeymap,
+
+    -- * Built-in Navigation Mode
+    defaultNavigation,
+    substringSearch,
+    navNSearch,
+
+    -- * Navigation Components
+    setPos,
+    move,
+    moveNext, movePrev,
+    select,
+    cancel,
+    transformSearchString,
+
+    -- * Screenshots
+    -- $screenshots
+
+    -- * Types
+    TwoDState,
+    ) where
+import Data.Maybe
+import Data.Bits
+import Data.Char
+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
+--
+-- You can build you own navigation mode and submodes by combining the
+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
+--
+-- > myNavigation :: TwoD a (Maybe a)
+-- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+-- >  where navKeyMap = M.fromList [
+-- >           ((0,xK_Escape), cancel)
+-- >          ,((0,xK_Return), select)
+-- >          ,((0,xK_slash) , substringSearch myNavigation)
+-- >          ,((0,xK_Left)  , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_h)     , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_Right) , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_l)     , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_Down)  , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_j)     , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_Up)    , move (0,-1)  >> myNavigation)
+-- >          ,((0,xK_y)     , move (-1,-1) >> myNavigation)
+-- >          ,((0,xK_i)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_n)     , move (-1,1)  >> myNavigation)
+-- >          ,((0,xK_m)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_space) , setPos (0,0) >> myNavigation)
+-- >          ]
+-- >        -- The navigation handler ignores unknown key symbols
+-- >        navDefaultHandler = const myNavigation
+--
+-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
+--
+-- > gsconfig3 = defaultGSConfig
+-- >    { gs_cellheight = 30
+-- >    , gs_cellwidth = 100
+-- >    , gs_navigate = myNavigation
+-- >    }
+
+-- $screenshots
+--
+-- Selecting a workspace:
+--
+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
+--
+-- Selecting a window by title:
+--
+-- <<http://haskell.org/wikiupload/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 :: TwoD a (Maybe a),
+      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 TwoDPosition = (Integer, Integer)
+
+type TwoDElementMap a = [(TwoDPosition,(String,a))]
+
+data TwoDState a = TwoDState { td_curpos :: TwoDPosition
+                             , td_availSlots :: [TwoDPosition]
+                             , td_elements :: [(String,a)]
+                             , td_gsconfig :: GSConfig a
+                             , td_font :: XMonadFont
+                             , td_paneX :: Integer
+                             , td_paneY :: Integer
+                             , td_drawingWin :: Window
+                             , td_searchString :: String
+                             }
+
+td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]
+td_elementmap s =
+  let positions = td_availSlots s
+      elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)
+  in zipWith (,) positions elements
+  where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]
+        upper = map toUpper
+
+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 a, Num a, Eq a) => a -> [(a, a)]
+diamondLayer 0 = [(0,0)]
+diamondLayer n =
+  -- tr = top right
+  --  r = ur ++ 90 degree clock-wise rotation of ur
+  let tr = [ (x,n-x) | x <- [0..n-1] ]
+      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)
+  in r ++ (map (negate *** negate) r)
+
+diamond :: (Enum a, Num a, Eq 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
+
+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
+      s <- get
+      updateElements (td_elementmap s)
+
+grayoutAllElements :: TwoD a ()
+grayoutAllElements =
+    do
+      s <- get
+      updateElementsWithColorizer grayOnly (td_elementmap s)
+    where grayOnly _ _ = return ("#808080", "#808080")
+
+updateElements :: TwoDElementMap a -> TwoD a ()
+updateElements elementmap = do
+      s <- get
+      updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap
+
+updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
+updateElementsWithColorizer colorizer 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 <- colorizer element (pos == curpos)
+            drawWinBox win font
+                       colors
+                       cellheight
+                       cellwidth
+                       text
+                       (paneX'+x*cellwidth)
+                       (paneY'+y*cellheight)
+                       (gs_cellpadding gsconfig)
+    mapM_ updateElement elementmap
+
+stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
+stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
+    | t == buttonRelease = do
+        s @  TwoDState { 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) (td_elementmap s) of
+             Just (_,el) -> return (Just el)
+             Nothing -> contEventloop
+    | otherwise = contEventloop
+
+stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
+
+stdHandle _ contEventloop = contEventloop
+
+-- | Embeds a key handler into the X event handler that dispatches key
+-- events to the key handler, while non-key event go to the standard
+-- handler.
+makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
+makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+                             ev <- getEvent e
+                             if ev_event_type ev == keyPress
+                               then do
+                                  (ks,s) <- lookupString $ asKeyEvent e
+                                  return $ do
+                                      mask <- liftX $ cleanMask (ev_state ev)
+                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)
+                               else
+                                  return $ stdHandle ev me
+
+-- | When the map contains (KeySym,KeyMask) tuple for the given event,
+-- the associated action in the map associated shadows the default key
+-- handler
+shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
+shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap)
+
+-- Helper functions to use for key handler functions
+
+-- | Closes gridselect returning the element under the cursor
+select :: TwoD a (Maybe a)
+select = do
+  s <- get
+  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+
+-- | Closes gridselect returning no element.
+cancel :: TwoD a (Maybe a)
+cancel = return Nothing
+
+-- | Sets the absolute position of the cursor.
+setPos :: (Integer, Integer) -> TwoD a ()
+setPos newPos = do
+  s <- get
+  let elmap = td_elementmap s
+      newSelectedEl = findInElementMap newPos (td_elementmap s)
+      oldPos = td_curpos s
+  when (isJust newSelectedEl && newPos /= oldPos) $ do
+    put s { td_curpos = newPos }
+    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+
+-- | Moves the cursor by the offsets specified
+move :: (Integer, Integer) -> TwoD a ()
+move (dx,dy) = do
+  s <- get
+  let (x,y) = td_curpos s
+      newPos = (x+dx,y+dy)
+  setPos newPos
+
+moveNext :: TwoD a ()
+moveNext = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just k | k == n-1 -> Just 0
+                      | otherwise -> Just (k+1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+movePrev :: TwoD a ()
+movePrev = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just 0  -> Just (n-1)
+               Just k  -> Just (k-1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+-- | Apply a transformation function the current search string
+transformSearchString :: (String -> String) -> TwoD a ()
+transformSearchString f = do
+          s <- get
+          let oldSearchString = td_searchString s
+              newSearchString = f oldSearchString
+          when (newSearchString /= oldSearchString) $ do
+            -- FIXME: grayoutAllElements + updateAllElements paint some fields twice causing flickering
+            --        we would need a much smarter update strategy to fix that
+            when (length newSearchString > length oldSearchString) grayoutAllElements
+            -- FIXME curpos might end up outside new bounds
+            put s { td_searchString = newSearchString }
+            updateAllElements
+
+-- | By default gridselect used the defaultNavigation action, which
+-- binds left,right,up,down and vi-style h,l,j,k navigation. Return
+-- quits gridselect, returning the selected element, while Escape
+-- cancels the selection. Slash enters the substring search mode. In
+-- substring search mode, every string-associated keystroke is
+-- added to a search string, which narrows down the object
+-- selection. Substring search mode comes back to regular navigation
+-- via Return, while Escape cancels the search. If you want that
+-- navigation style, add 'defaultNavigation' as 'gs_navigate' to your
+-- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.
+defaultNavigation :: TwoD a (Maybe a)
+defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+  where navKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_slash)      , substringSearch defaultNavigation)
+          ,((0,xK_Left)       , move (-1,0) >> defaultNavigation)
+          ,((0,xK_h)          , move (-1,0) >> defaultNavigation)
+          ,((0,xK_Right)      , move (1,0) >> defaultNavigation)
+          ,((0,xK_l)          , move (1,0) >> defaultNavigation)
+          ,((0,xK_Down)       , move (0,1) >> defaultNavigation)
+          ,((0,xK_j)          , move (0,1) >> defaultNavigation)
+          ,((0,xK_Up)         , move (0,-1) >> defaultNavigation)
+          ,((0,xK_k)          , move (0,-1) >> defaultNavigation)
+          ,((0,xK_Tab)        , moveNext >> defaultNavigation)
+          ,((0,xK_n)          , moveNext >> defaultNavigation)
+          ,((shiftMask,xK_Tab), movePrev >> defaultNavigation)
+          ,((0,xK_p)          , movePrev >> defaultNavigation)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navDefaultHandler = const defaultNavigation
+
+-- | This navigation style combines navigation and search into one mode at the cost of losing vi style
+-- navigation. With this style, there is no substring search submode,
+-- but every typed character is added to the substring search.
+navNSearch :: TwoD a (Maybe a)
+navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler
+  where navNSearchKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_Left)       , move (-1,0) >> navNSearch)
+          ,((0,xK_Right)      , move (1,0) >> navNSearch)
+          ,((0,xK_Down)       , move (0,1) >> navNSearch)
+          ,((0,xK_Up)         , move (0,-1) >> navNSearch)
+          ,((0,xK_Tab)        , moveNext >> navNSearch)
+          ,((shiftMask,xK_Tab), movePrev >> navNSearch)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navNSearchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          navNSearch
+
+-- | Navigation submode used for substring search. It returns to the
+-- first argument navigation style when the user hits Return.
+substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
+substringSearch returnNavigation = fix $ \me ->
+  let searchKeyMap = M.fromList [
+           ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)
+          ,((0,xK_Return)   , returnNavigation)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
+          ]
+      searchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          me
+  in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler
+
+
+-- 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 _ [] = return Nothing
+gridselect gsconfig elements =
+ 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
+
+                            evalTwoD (updateAllElements >> (gs_navigate gsconfig)) TwoDState { td_curpos = (head coords),
+                                                                                  td_availSlots = coords,
+                                                                                  td_elements = elements,
+                                                                                  td_gsconfig = gsconfig,
+                                                                                  td_font = font,
+                                                                                  td_paneX = screenWidth,
+                                                                                  td_paneY = screenHeight,
+                                                                                  td_drawingWin = win,
+                                                                                  td_searchString = "" }
+                      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" defaultNavigation (1/2) (1/2)
+
+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 ()
+
+-- | Select a workspace and view it using the given function
+-- (normally 'W.view' or 'W.greedyView')
+--
+-- Another option is to shift the current window to the selected workspace:
+--
+-- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)
+gridselectWorkspace :: GSConfig WorkspaceId ->
+                          (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
+    let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws)
+    gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)

XMonad/Actions/GroupNavigation.hs

@@ -0,0 +1,218 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Actions.GroupNavigation
+-- Copyright   : (c) nzeh@cs.dal.ca
+-- License     : BSD3-style (see LICENSE)
+--
+-- Maintainer  : nzeh@cs.dal.ca
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Provides methods for cycling through groups of windows across
+-- workspaces, ignoring windows that do not belong to this group.  A
+-- group consists of all windows matching a user-provided boolean
+-- query.
+--
+-- Also provides a method for jumping back to the most recently used
+-- window in any given group.
+--
+----------------------------------------------------------------------
+
+module XMonad.Actions.GroupNavigation ( -- * Usage  
+                                        -- $usage
+                                        Direction (..)
+                                      , nextMatch
+                                      , nextMatchOrDo
+                                      , nextMatchWithThis
+                                      , historyHook
+                                      ) where
+
+import Control.Monad.Reader
+import Data.Foldable as Fold
+import Data.Map as Map
+import Data.Sequence as Seq
+import Data.Set as Set
+import Graphics.X11.Types
+import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
+import XMonad.Core
+import XMonad.ManageHook
+import XMonad.Operations (windows, withFocused)
+import qualified XMonad.StackSet as SS
+import qualified XMonad.Util.ExtensibleState as XS
+
+{- $usage
+
+Import the module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions,GroupNavigation
+
+To support cycling forward and backward through all xterm windows, add
+something like this to your keybindings:
+
+> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
+> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))
+
+These key combinations do nothing if there is no xterm window open.
+If you rather want to open a new xterm window if there is no open
+xterm window, use 'nextMatchOrDo' instead:
+
+> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
+> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))
+
+You can use 'nextMatchWithThis' with an arbitrary query to cycle
+through all windows for which this query returns the same value as the
+current window.  For example, to cycle through all windows in the same
+window class as the current window use:
+
+> , ((modm , xK_f), nextMatchWithThis Forward  className)
+> , ((modm , xK_b), nextMatchWithThis Backward className)
+
+Finally, you can define keybindings to jump to the most recent window
+matching a certain Boolean query.  To do this, you need to add
+'historyHook' to your logHook:
+
+> main = xmonad $ defaultConfig { logHook = historyHook }
+
+Then the following keybindings, for example, allow you to return to
+the most recent xterm or emacs window or to simply to the most recent
+window:
+
+> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
+> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
+> , ((modm                , xK_BackSpace), nextMatch History (return True))
+
+Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
+to execute an action if no window matching the query exists. -}
+
+--- Basic cyclic navigation based on queries -------------------------
+
+-- | The direction in which to look for the next match
+data Direction = Forward  -- ^ Forward from current window or workspace
+               | Backward -- ^ Backward from current window or workspace
+               | History  -- ^ Backward in history
+
+-- | Focuses the next window for which the given query produces the
+-- same result as the currently focused window.  Does nothing if there
+-- is no focused window (i.e., the current workspace is empty).
+nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
+nextMatchWithThis dir qry = withFocused $ \win -> do
+  prop <- runQuery qry win
+  nextMatch dir (qry =? prop)
+
+-- | Focuses the next window that matches the given boolean query.
+-- Does nothing if there is no such window.  This is the same as
+-- 'nextMatchOrDo' with alternate action @return ()@.
+nextMatch :: Direction -> Query Bool -> X ()
+nextMatch dir qry = nextMatchOrDo dir qry (return ())
+
+-- | Focuses the next window that matches the given boolean query.  If
+-- there is no such window, perform the given action instead.
+nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
+nextMatchOrDo dir qry act = orderedWindowList dir 
+                            >>= focusNextMatchOrDo qry act
+
+-- Produces the action to perform depending on whether there's a
+-- matching window
+focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
+focusNextMatchOrDo qry act = findM (runQuery qry) 
+                             >=> maybe act (windows . SS.focusWindow)
+
+-- Returns the list of windows ordered by workspace as specified in
+-- ~/.xmonad/xmonad.hs
+orderedWindowList :: Direction -> X (Seq Window)
+orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
+orderedWindowList dir     = withWindowSet $ \ss -> do
+  wsids <- asks (Seq.fromList . workspaces . config)
+  let wspcs = orderedWorkspaceList ss wsids
+      wins  = dirfun dir 
+              $ Fold.foldl' (><) Seq.empty
+              $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
+      cur   = SS.peek ss
+  return $ maybe wins (rotfun wins) cur
+  where
+    dirfun Backward = Seq.reverse
+    dirfun _        = id
+    rotfun wins x   = rotate $ rotateTo (== x) wins
+
+-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
+orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
+orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
+    where
+      wspcs      = SS.workspaces ss
+      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
+      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
+      isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
+
+--- History navigation, requires a layout modifier -------------------
+
+-- The state extension that holds the history information
+data HistoryDB = HistoryDB (Maybe Window) -- currently focused window 
+                           (Seq Window)   -- previously focused windows
+               deriving (Read, Show, Typeable)
+
+instance ExtensionClass HistoryDB where
+
+    initialValue  = HistoryDB Nothing Seq.empty
+    extensionType = PersistentExtension
+
+-- | Action that needs to be executed as a logHook to maintain the
+-- focus history of all windows as the WindowSet changes.
+historyHook :: X ()
+historyHook = XS.get >>= updateHistory >>= XS.put
+
+-- Updates the history in response to a WindowSet change
+updateHistory :: HistoryDB -> X HistoryDB
+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
+  let newcur   = SS.peek ss
+      wins     = Set.fromList $ SS.allWindows ss
+      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
+  return $ HistoryDB newcur (del newcur newhist)
+  where
+    ins x xs = maybe xs (<| xs) x
+    del x xs = maybe xs (\x' -> flt (/= x') xs) x
+
+--- Two replacements for Seq.filter and Seq.breakl available only in
+--- containers-0.3.0.0, which only ships with ghc 6.12.  Once we
+--- decide to no longer support ghc < 6.12, these should be replaced
+--- with Seq.filter and Seq.breakl.
+
+flt :: (a -> Bool) -> Seq a -> Seq a
+flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
+
+brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+brkl p xs = flip Seq.splitAt xs 
+            $ snd 
+            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
+  where
+    l = Seq.length xs
+    
+--- Some sequence helpers --------------------------------------------
+
+-- Rotates the sequence by one position
+rotate :: Seq a -> Seq a
+rotate xs = rotate' (viewl xs)
+  where
+    rotate' EmptyL      = Seq.empty
+    rotate' (x' :< xs') = xs' |> x'
+
+-- Rotates the sequence until an element matching the given condition
+-- is at the beginning of the sequence.
+rotateTo :: (a -> Bool) -> Seq a -> Seq a
+rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
+
+--- A monadic find ---------------------------------------------------
+
+-- Applies the given action to every sequence element in turn until
+-- the first element is found for which the action returns true.  The
+-- remaining elements in the sequence are ignored.
+findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
+findM cond xs = findM' cond (viewl xs)
+  where
+    findM' _   EmptyL      = return Nothing
+    findM' qry (x' :< xs') = do
+      isMatch <- qry x'
+      if isMatch
+        then return (Just x')
+        else findM qry xs'

XMonad/Actions/KeyRemap.hs

@@ -0,0 +1,156 @@
+ {-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.KeyRemap
+-- Copyright   :  (c) Christian Dietrich
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  stettberger@dokucde.de
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift 
+-- is left us Layout
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.KeyRemap (
+  -- * Usage
+  -- $usage
+  setKeyRemap,
+  buildKeyRemapBindings,
+  setDefaultKeyRemap,
+
+  KeymapTable (KeymapTable),
+  emptyKeyRemap,
+  dvorakProgrammerKeyRemap
+  ) where
+
+import XMonad
+import XMonad.Util.Paste
+import Data.List
+
+import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad
+
+
+data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
+
+instance ExtensionClass KeymapTable where
+   initialValue = KeymapTable []
+
+-- $usage
+-- Provides the possibility to remap parts of the keymap to generate different keys
+--
+-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout 
+--   after all
+--
+-- First, you must add all possible keybindings for all layout you want to use:
+--
+-- >   keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]
+--
+-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the
+-- empty keyremap (no remapping is done) as default after startup):
+--
+-- > myStartupHook :: X()
+-- > myStartupHook = do
+-- >   setWMName "LG3D"
+-- >   setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]
+--
+-- Then you add keybindings for changing keyboard layouts;
+--
+-- > , ((0                    , xK_F1    ), setKeyRemap emptyKeyRemap)
+-- > , ((0                    , xK_F2    ), setKeyRemap dvorakProgrammerKeyRemap)
+--
+-- When defining your own keymappings, please be aware of:
+--
+-- * If you want to emulate a key that is shifted on us you must emulate that keypress:
+--
+-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'
+-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'
+--
+-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate
+--   the KeymapTable
+--
+-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap
+--   are nessesary
+
+doKeyRemap :: KeyMask -> KeySym -> X()
+doKeyRemap mask sym = do
+  table <- XS.get
+  let (insertMask, insertSym) = extractKeyMapping table mask sym
+  sendKey insertMask insertSym
+
+-- | Using this in the keybindings to set the actual Key Translation table
+setKeyRemap :: KeymapTable -> X()
+setKeyRemap table = do
+  let KeymapTable newtable = table
+  KeymapTable oldtable <- XS.get
+  XConf { display = dpy, theRoot = rootw } <- ask
+
+  let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+  let ungrab kc m = io $ ungrabKey dpy kc m rootw
+
+  forM_ oldtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ ungrab kc mask
+
+  forM_ newtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ grab kc mask
+
+  XS.put table
+
+-- | Adding this to your startupHook, to select your default Key Translation table.
+--   You also must give it all the KeymapTables you are willing to use
+setDefaultKeyRemap  :: KeymapTable -> [KeymapTable] -> X()
+setDefaultKeyRemap dflt keyremaps = do
+  XS.put (KeymapTable mappings)
+  setKeyRemap dflt
+  where
+    mappings = nub (keyremaps >>= \(KeymapTable table) -> table)
+
+extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)
+extractKeyMapping (KeymapTable table) mask sym =
+  insertKey filtered
+  where filtered = filter (\((m, s),_) -> m == mask && s == sym) table
+        insertKey [] = (mask, sym)
+        insertKey ((_, to):_) = to
+
+-- | Append the output of this function to your keybindings with ++
+buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
+buildKeyRemapBindings keyremaps =
+  [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
+  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
+        bindings = nub (map (\binding -> fst binding) mappings)
+
+
+-- Here come the Keymappings
+-- | The empty KeymapTable, does no translation
+emptyKeyRemap :: KeymapTable
+emptyKeyRemap = KeymapTable []
+
+-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers
+dvorakProgrammerKeyRemap :: KeymapTable
+dvorakProgrammerKeyRemap =
+  KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
+               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
+  where
+
+    layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]
+    layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./"  :: [KeySym]
+    layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
+
+    layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]
+
+    layoutDvorakShift = map getShift layoutDvorak
+    layoutDvorakKey   = map getKey layoutDvorak
+    getKey  char = let Just index = elemIndex char layoutUs
+                    in layoutUsKey !! index
+    getShift char = let Just index = elemIndex char layoutUs
+                    in layoutUsShift !! index
+    charToMask char = if [char] == "0" then 0 else shiftMask

XMonad/Actions/MessageFeedback.hs

@@ -0,0 +1,99 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.MessageFeedback
+-- Copyright    : (c) Quentin Moser <moserq@gmail.com>
+-- License      : BSD3
+--
+-- Maintainer   : orphaned
+-- 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,14 +15,14 @@
 module XMonad.Actions.MouseGestures (
     -- * Usage
     -- $usage
-    Direction(..),
+    Direction2D(..),
     mouseGestureH,
     mouseGesture,
     mkCollect
 ) where
 
 import XMonad
-import XMonad.Layout.WindowNavigation (Direction(..))
+import XMonad.Util.Types (Direction2D(..))
 
 import Data.IORef
 import qualified Data.Map as M
@@ -39,7 +39,7 @@ import Control.Monad
 --
 -- 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:
@@ -64,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
@@ -75,7 +75,7 @@ dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromInt
         | otherwise          = L
     rg a z x = a <= x && x < z
 
-gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X ()
+gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
 gauge hook op st nx ny = do
     let np = (nx, ny)
     stx <- io $ readIORef st
@@ -96,7 +96,7 @@ gauge hook op st nx ny = 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 :: (Direction -> X ()) -> X () -> X ()
+mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
 mouseGestureH moveHook endHook = do
     dpy <- asks display
     root <- asks theRoot
@@ -108,7 +108,7 @@ mouseGestureH moveHook endHook = do
 
 -- | 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 [Direction] (Window -> X ()) -> Window -> X ()
+mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
 mouseGesture tbl win = do
     (mov, end) <- mkCollect
     mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
@@ -121,7 +121,7 @@ mouseGesture tbl win = do
 -- 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 (Direction -> m' [Direction], m' [Direction])
+mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
 mkCollect = liftIO $ do
     acc <- newIORef []
     let

XMonad/Actions/MouseResize.hs

@@ -23,12 +23,8 @@ module XMonad.Actions.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
@@ -47,11 +43,11 @@ import XMonad.Util.XUtils
 --
 -- Then edit your @layoutHook@ by modifying a given layout:
 --
--- > myLayouts = mouseResize $ windowArrange $ layoutHook defaultConfig
+-- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig
 --
 -- and then:
 --
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
@@ -65,7 +61,8 @@ instance Show (MouseResize a) where show        _ = ""
 instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
 
 instance LayoutModifier MouseResize Window where
-    redoLayout (MR st) _ s wrs
+    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
@@ -113,6 +110,11 @@ createInputWindow ((w,r),mr) = do
     Just tr  -> withDisplay $ \d -> do
                   tw <- mkInputWindow d tr
                   io $ selectInput d tw (exposureMask .|. buttonPressMask)
+
+                  cursor <- io $ createFontCursor d xC_bottom_right_corner
+                  io $ defineCursor d tw cursor
+                  io $ freeCursor d cursor
+
                   showWindow tw
                   return ((w,r), Just tw)
     Nothing ->    return ((w,r), Nothing)

XMonad/Actions/NoBorders.hs

@@ -5,7 +5,7 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Lukas Mai <l.mai@web.de>
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
 -- This module provides helper functions for dealing with window borders.
@@ -21,7 +21,7 @@ import XMonad
 -- | Toggle the border of the currently focused window. To use it, add a
 -- keybinding like so:
 --
--- > , ((modMask x,  xK_g ),   withFocused toggleBorder)
+-- > , ((modm,  xK_g ),   withFocused toggleBorder)
 --
 toggleBorder :: Window -> X ()
 toggleBorder w = do

XMonad/Actions/OnScreen.hs

@@ -0,0 +1,188 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+    , onScreen'
+    , Focus(..)
+    , viewOnScreen
+    , greedyViewOnScreen
+    , onlyOnScreen
+    , toggleOnScreen
+    , toggleGreedyOnScreen
+    ) where
+
+import XMonad
+import XMonad.StackSet hiding (new)
+
+import Control.Monad (guard)
+-- import Control.Monad.State.Class (gets)
+import Data.Maybe (fromMaybe)
+
+
+-- | Focus data definitions
+data Focus = FocusNew                       -- ^ always focus the new screen
+           | FocusCurrent                   -- ^ always keep the focus on the current screen
+           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack
+           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack
+
+
+-- | Run any function that modifies the stack on a given screen. This function
+-- will also need to know which Screen to focus after the function has been
+-- run.
+onScreen :: (WindowSet -> WindowSet) -- ^ function to run
+         -> Focus                    -- ^ what to do with the focus
+         -> ScreenId                 -- ^ screen id
+         -> WindowSet                -- ^ current stack
+         -> WindowSet
+onScreen f foc sc st = fromMaybe st $ do
+    ws <- lookupWorkspace sc st
+
+    let fStack      = f $ view ws st
+
+    return $ setFocus foc st fStack
+
+
+-- set focus for new stack
+setFocus :: Focus
+         -> WindowSet -- ^ old stack
+         -> WindowSet -- ^ new stack
+         -> WindowSet
+setFocus FocusNew _ new             = new
+setFocus FocusCurrent old new        =
+    case lookupWorkspace (screen $ current old) new of
+         Nothing -> new
+         Just i -> view i new
+setFocus (FocusTag i) _ new         = view i new
+setFocus (FocusTagVisible i) old new =
+    if i `elem` map (tag . workspace) (visible old)
+       then setFocus (FocusTag i) old new
+       else setFocus FocusCurrent old new
+
+-- | A variation of @onScreen@ which will take any @X ()@ function and run it
+-- on the given screen.
+-- Warning: This function will change focus even if the function it's supposed
+-- to run doesn't succeed.
+onScreen' :: X ()       -- ^ X function to run
+          -> Focus      -- ^ focus
+          -> ScreenId   -- ^ screen id
+          -> X ()
+onScreen' x foc sc = do
+    st <- gets windowset
+    case lookupWorkspace sc st of
+         Nothing -> return ()
+         Just ws -> do
+             windows $ view ws
+             x
+             windows $ setFocus foc st
+
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to
+-- switch focus to the workspace @i@.
+viewOnScreen :: ScreenId    -- ^ screen id
+             -> WorkspaceId -- ^ index of the workspace
+             -> WindowSet   -- ^ current stack
+             -> WindowSet
+viewOnScreen sid i =
+    onScreen (view i) (FocusTag i) sid
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@
+-- to switch the current workspace with workspace @i@.
+greedyViewOnScreen :: ScreenId    -- ^ screen id
+                   -> WorkspaceId -- ^ index of the workspace
+                   -> WindowSet   -- ^ current stack
+                   -> WindowSet
+greedyViewOnScreen sid i =
+    onScreen (greedyView i) (FocusTagVisible i) sid
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.
+onlyOnScreen :: ScreenId    -- ^ screen id
+             -> WorkspaceId -- ^ index of the workspace
+             -> WindowSet   -- ^ current stack
+             -> WindowSet
+onlyOnScreen sid i =
+    onScreen (view i) FocusCurrent sid
+
+-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
+toggleOnScreen :: ScreenId    -- ^ screen id
+               -> WorkspaceId -- ^ index of the workspace
+               -> WindowSet   -- ^ current stack
+               -> WindowSet
+toggleOnScreen sid i =
+    onScreen (toggleOrView' view i) FocusCurrent sid
+
+-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
+toggleGreedyOnScreen :: ScreenId    -- ^ screen id
+                     -> WorkspaceId -- ^ index of the workspace
+                     -> WindowSet   -- ^ current stack
+                     -> WindowSet
+toggleGreedyOnScreen sid i =
+    onScreen (toggleOrView' greedyView i) FocusCurrent sid
+
+
+-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip
+toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet)   -- ^ function to run
+              -> WorkspaceId                               -- ^ tag to look for
+              -> WindowSet                                 -- ^ current stackset
+              -> WindowSet
+toggleOrView' f i st = fromMaybe (f i st) $ do
+    let st' = hidden st
+    -- make sure we actually have to do something
+    guard $ i == (tag . workspace $ current st)
+    guard $ not (null st')
+    -- finally, toggle!
+    return $ f (tag . head $ st') st
+
+
+-- $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".

XMonad/Actions/PerWorkspaceKeys.hs

@@ -21,7 +21,6 @@ module XMonad.Actions.PerWorkspaceKeys (
 
 import XMonad
 import XMonad.StackSet as S
-import Data.List (find)
 
 -- $usage
 --
@@ -36,15 +35,15 @@ import Data.List (find)
 
 -- | Uses supplied function to decide which action to run depending on current workspace name.
 chooseAction :: (String->X()) -> X()
-chooseAction f = withWindowSet (f . S.tag . S.workspace . S.current)
+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
+    chooser ws = case lookup ws bindings of
+        Just action -> action
+        Nothing -> case lookup "" bindings of
+            Just action -> action
             Nothing -> return ()
 

XMonad/Actions/PhysicalScreens.hs

@@ -0,0 +1,115 @@
+{-# 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
+                                      , onNextNeighbour
+                                      , onPrevNeighbour
+                                      ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Data.List (sortBy,findIndex)
+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
+
+> , ((modMask, xK_a), onPrevNeighbour W.view)
+> , ((modMask, xK_o), onNextNeighbour W.view)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
+
+> --
+> -- 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) = do w <- gets windowset
+                     let screens = W.current w : W.visible w
+                     if i<0 || i >= length screens
+                      then return Nothing
+                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
+                           in return $ Just $ W.screen $ 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)
+
+
+-- | Get ScreenId for neighbours of the current screen based on position offset.
+getNeighbour :: Int -> X ScreenId
+getNeighbour d = do w <- gets windowset
+                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
+                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
+                        pos = (curPos + d) `mod` length ss
+                    return $ ss !! pos
+
+neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows d f = do s <- getNeighbour d
+                          w <- screenWorkspace s
+                          whenJust w $ windows . f
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
+onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onNextNeighbour = neighbourWindows 1
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
+onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onPrevNeighbour = neighbourWindows (-1)
+

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

@@ -33,7 +33,7 @@ import XMonad.StackSet
 --
 -- then add a keybinding or substitute 'promote' in place of swapMaster:
 --
--- >   , ((modMask x,               xK_Return), promote)
+-- >   , ((modm,               xK_Return), promote)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".

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,7 +5,7 @@
 -- 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
@@ -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/Search.hs

@@ -1,47 +1,75 @@
-{- |
- Module      :  XMonad.Actions.Search
- Copyright   :  (C) 2007 Gwern Branwen
- License     :  None; public domain
+{- | Module      :  XMonad.Actions.Search
+   Copyright   :  (C) 2007 Gwern Branwen
+   License     :  None; public domain
 
- Maintainer  :  <gwern0@gmail.com>
- Stability   :  unstable
- Portability :  unportable
+   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>.
+   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
+   Additional sites welcomed. -}
+module XMonad.Actions.Search (   -- * Usage
+                                 -- $usage
                                  search,
-                                 simpleEngine,
+                                 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,
+                                 openstreetmap,
                                  scholar,
+                                 thesaurus,
                                  wayback,
-                                 wikipedia
-
-                                    -- * Use case: searching with a submap
-                                    -- $tip
+                                 wikipedia,
+                                 wiktionary,
+                                 youtube,
+                                 multi,
+                                  -- * Use case: searching with a submap
+                                  -- $tip
 
+                                  -- * Types
+                                 Browser, Site, Query, Name, Search
                           ) where
 
-import Data.Char (chr, ord, isAlpha, isMark, isDigit)
-import Numeric (showIntAtBase)
-import XMonad (X(), MonadIO)
-import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())
-import XMonad.Prompt.Shell (getShellCompl)
+import Codec.Binary.UTF8.String (encode)
+import Data.Char (isAlphaNum, isAscii)
+import Data.List (isPrefixOf)
+import Text.Printf
+import XMonad (X(), MonadIO, liftIO)
+import XMonad.Prompt (XPrompt(showXPrompt, nextCompletion, commandToComplete), mkXPrompt, XPConfig(), historyCompletionP, getNextCompletion)
+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
@@ -62,30 +90,57 @@ import XMonad.Util.XSelection (getSelection)
    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 'simpleEngine'.
+   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.
 
-* 'hoogle' -- Hoogle, the Haskell libraries search engine.
+* '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.
 
+* 'openstreetmap' -- OpenStreetMap free wiki world map.
+
 * 'scholar' -- Google scholar academic search.
 
+* 'thesaurus' -- thesaurus.reference.com search.
+
 * 'wayback' -- the Wayback Machine.
 
 * 'wikipedia' -- basic Wikipedia search.
 
-Feel free to add more!
--}
+* '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
 
@@ -108,11 +163,27 @@ Then add the following to your key bindings:
 > ...
 >
 > searchEngineMap method = M.fromList $
->       [ ((0, xK_g), method \"firefox\" S.google)
->       , ((0, xK_h), method \"firefox\" S.hoogle)
->       , ((0, xK_w), method \"firefox\" S.wikipedia)
+>       [ ((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...@
@@ -125,91 +196,178 @@ 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!
--}
+Happy searching! -}
 
--- A customized prompt.
-data Search = Search
+-- | A customized prompt indicating we are searching, and the name of the site.
+data Search = Search Name
 instance XPrompt Search where
-    showXPrompt Search = "Search: "
+    showXPrompt (Search name)= "Search [" ++ name ++ "]: "
+    nextCompletion _ = getNextCompletion
+    commandToComplete _ c = c
 
--- | 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 the search string so search engines understand it. Only
+-- digits and ASCII letters are not encoded. All non ASCII characters
+-- which are encoded as UTF8
 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 p s = concatMap (escapeURIChar p) s
-           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))
+escape = concatMap escapeURIChar
+
+escapeURIChar :: Char -> String
+escapeURIChar c | isAscii c && isAlphaNum c = [c]
+                | otherwise                 = concatMap (printf "%%%02X") $ encode [c]
 
 type Browser      = FilePath
 type Query        = String
-type SearchEngine = String -> String
+type Site         = String -> String
+type Name         = String
+data SearchEngine = SearchEngine Name Site
 
-{- | Given a browser, a search engine, and a search term, perform the
-     requested search in the browser. -}
-search :: MonadIO m => Browser -> SearchEngine -> Query -> m ()
-search browser site query = safeSpawn browser $ site query
+-- | 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 base URL, create the SearchEngine that escapes the query and
-   appends it to the base. You can easily define a new engine locally using simpleEngine
-   without needing to modify Search.hs:
+-- | 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]
 
-   > newEngine = simpleEngine "http://site.com/search="
+{- | 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":
 
-   The important thing is that the site has a interface which accepts the query
-   string as part of the URL. Alas, the exact URL to feed simpleEngine varies
-   from site to site, often considerably. 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. -}
-simpleEngine :: Query -> SearchEngine
-simpleEngine site query = site ++ escape query
+> 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 | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
+>              | "http://" `isPrefixOf` s = 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, google, hoogle, imdb, maps, mathworld, scholar, wayback, wikipedia :: SearchEngine
-amazon    = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
-google    = simpleEngine "http://www.google.com/search?num=100&q="
-hoogle    = simpleEngine "http://www.haskell.org/hoogle/?q="
-imdb      = simpleEngine "http://www.imdb.com/Find?select=all&for="
-maps      = simpleEngine "http://maps.google.com/maps?q="
-mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query="
-scholar   = simpleEngine "http://scholar.google.com/scholar?q="
-wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
-wayback   = simpleEngine "http://web.archive.org/"
-{- 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. -}
+amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
+  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, 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?s=all&q="
+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="
+openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
+scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="
+thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="
+wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/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="
+wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)
+
+multi :: SearchEngine
+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, 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 (name1++":") `isPrefixOf` s 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 (name++":") `isPrefixOf` s 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 "firefox" google)
+> , ((modm, xK_g), promptSearch greenXPConfig google)
 
--}
-promptSearch :: XPConfig -> Browser -> SearchEngine -> X ()
-promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site
+   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 given browser. Example:
+   passes it to a given searchEngine and opens it in the default browser . Example:
 
-> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google)
+> , ((modm .|. shiftMask, xK_g), selectSearch google)
 
--}
-selectSearch :: MonadIO m => Browser -> SearchEngine -> m ()
-selectSearch browser searchEngine = search browser searchEngine =<< getSelection
+   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

@@ -5,17 +5,20 @@
 -- 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,123 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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,
+    manageSpawn,
+    spawnHere,
+    spawnOn,
+    spawnAndDo,
+    shellPromptHere,
+    shellPromptOn
+) where
+
+import Data.List (isInfixOf)
+import System.Posix.Types (ProcessID)
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Hooks.ManageHelpers
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.SpawnOn
+--
+-- >    main = do
+-- >      xmonad defaultConfig {
+-- >         ...
+-- >         manageHook = manageSpawn <+> manageHook defaultConfig
+-- >         ...
+-- >      }
+--
+-- To ensure that application appears on a workspace it was launched at, add keybindings like:
+--
+-- >  , ((mod1Mask,xK_o), spawnHere "urxvt")
+-- >  , ((mod1Mask,xK_s), shellPromptHere 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 :: [(ProcessID, ManageHook)]} deriving Typeable
+
+instance ExtensionClass Spawner where
+    initialValue = Spawner []
+
+maxPids :: Int
+maxPids = 5
+
+-- | Get the current Spawner or create one if it doesn't exist.
+modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
+modifySpawner f = XS.modify (Spawner . f . pidsRef)
+
+-- | Provides a manage hook to react on process spawned with
+-- 'spawnOn', 'spawnHere' etc.
+manageSpawn :: ManageHook
+manageSpawn = do
+    Spawner pids <- liftX XS.get
+    mp <- pid
+    case flip lookup pids =<< mp of
+        Nothing -> idHook
+        Just mh  -> do
+            whenJust mp $ \p ->
+                liftX . modifySpawner $ 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 :: XPConfig -> X ()
+shellPromptHere = mkPrompt spawnHere
+
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on given workspace.
+shellPromptOn :: WorkspaceId -> XPConfig -> X ()
+shellPromptOn ws = mkPrompt (spawnOn ws)
+
+-- | Replacement for 'spawn' which launches
+-- application on current workspace.
+spawnHere :: String -> X ()
+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
+
+-- | Replacement for 'spawn' which launches
+-- application on given workspace.
+spawnOn :: WorkspaceId -> String -> X ()
+spawnOn ws cmd = spawnAndDo (doShift ws) cmd
+
+-- | Spawn an application and apply the manage hook when it opens.
+spawnAndDo :: ManageHook -> String -> X ()
+spawnAndDo mh cmd = do
+    p <- spawnPID $ mangle cmd
+    modifySpawner $ (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,9 @@ 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)
 
     io $ ungrabKeyboard d currentTime
 
-    m' <- cleanMask m
-    whenJust (M.lookup (m', s) keys) id
+    maybe def id (M.lookup (m', s) keys)

XMonad/Actions/SwapWorkspaces.hs

@@ -17,10 +17,15 @@ 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.WorkspaceCompare
 
 
 -- $usage
@@ -31,7 +36,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 +48,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

@@ -22,17 +22,23 @@ module XMonad.Actions.TagWindows (
                  focusDownTagged, focusDownTaggedGlobal,
                  shiftHere, shiftToScreen,
                  tagPrompt,
-                 tagDelPrompt
+                 tagDelPrompt,
+                 TagPrompt,
                  ) where
 
-import Data.List (nub,concat,sortBy)
+import Prelude hiding (catch)
+import Data.List (nub,sortBy)
 import Control.Monad
+import Control.Exception
 
 import XMonad.StackSet hiding (filter)
 
 import XMonad.Prompt
 import XMonad hiding (workspaces)
 
+econst :: Monad m => a -> IOException -> m a
+econst = const . return
+
 -- $usage
 --
 -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
@@ -42,16 +48,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))
 --
@@ -79,7 +85,7 @@ getTags w = withDisplay $ \d ->
     io $ catch (internAtom d "_XMONAD_TAGS" False >>=
                 getTextProperty d w >>=
                 wcTextPropertyToTextList d)
-               (\_ -> return [[]])
+               (econst [[]])
     >>= return . words . unwords
 
 -- | check a window for the given tag
@@ -120,7 +126,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 +155,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 +165,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

XMonad/Actions/TopicSpace.hs

@@ -0,0 +1,316 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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(..)
+  , defaultTopicConfig
+  , getLastFocusedTopics
+  , setLastFocusedTopic
+  , reverseLastFocusedTopics
+  , pprWindowSet
+  , topicActionWithPrompt
+  , topicAction
+  , currentTopicAction
+  , switchTopic
+  , switchNthLastFocused
+  , shiftNthLastFocused
+  , currentTopicDir
+  , checkTopicConfig
+  , (>*>)
+  )
+where
+
+import XMonad
+
+import Data.List
+import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
+import Data.Ord
+import qualified Data.Map as M
+import Control.Monad (liftM2,when,unless,replicateM_)
+import System.IO
+
+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 qualified XMonad.Util.ExtensibleState as XS
+
+-- $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 = defaultTopicConfig
+-- >   { 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"
+-- >   , 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)
+-- >   {- more  keys ... -}
+-- >   ]
+-- >   ++
+-- >   [ ((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.
+                               }
+
+defaultTopicConfig :: TopicConfig
+defaultTopicConfig = TopicConfig { topicDirs = M.empty
+                                 , topicActions = M.empty
+                                 , defaultTopicAction = const (ask >>= spawn . terminal . config)
+                                 , defaultTopic = "1"
+                                 , maxTopicHistory = 10
+                                 }
+
+newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
+instance ExtensionClass PrevTopics where
+    initialValue = PrevTopics []
+    extensionType = PersistentExtension
+
+-- | Returns the list of last focused workspaces the empty list otherwise.
+getLastFocusedTopics :: X [String]
+getLastFocusedTopics = XS.gets getPrevTopics
+
+-- | 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 :: Topic -> (Topic -> Bool) -> X ()
+setLastFocusedTopic w predicate =
+  XS.modify $ PrevTopics
+    . seqList . nub . (w:) . filter predicate
+    . getPrevTopics
+  where seqList xs = length xs `seq` xs
+
+-- | Reverse the list of "last focused topics"
+reverseLastFocusedTopics :: X ()
+reverseLastFocusedTopics =
+  XS.modify $ PrevTopics . reverse . getPrevTopics
+
+-- | 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 (W.tag . W.workspace . W.current $ winset)
+                        (`notElem` empty_workspaces)
+    lastWs <- getLastFocusedTopics
+    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
+        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
+        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
+        sortWindows = take maxDepth . sortBy (comparing $ 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,60 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 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
+      foc <- withWindowSet $ return . W.peek
+      -- get the window under the pointer:
+      (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)
+      when (foc /= Just 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

@@ -3,7 +3,7 @@
 -- 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
@@ -14,7 +14,7 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Actions.UpdatePointer 
+module XMonad.Actions.UpdatePointer
     (
      -- * Usage
      -- $usage
@@ -24,7 +24,10 @@ module XMonad.Actions.UpdatePointer
     where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 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@:
@@ -33,9 +36,9 @@ import Control.Monad
 -- > 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)
@@ -45,37 +48,58 @@ import Control.Monad
 -- To use this with an existing logHook, use >> :
 --
 -- > logHook = dynamicLog
--- >           >> updatePointer (RelativePosition 1 1)
+-- >           >> updatePointer (Relative 1 1)
 --
 -- which moves the pointer to the bottom-right corner of the focused window.
 
-data PointerPosition = Nearest | Relative Rational Rational
+data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational
+    deriving (Read,Show)
 
 -- | Update the pointer's location to the currently focused
--- window unless it's already there
+-- window or empty screen unless it's already there, or unless the user was changing
+-- focus with the mouse
 updatePointer :: PointerPosition -> X ()
-updatePointer p = withFocused $ \w -> do
+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
-  wa <- io $ getWindowAttributes dpy w
-  (_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root
-  -- Can sameRoot ever be false in this case? I'm going to assume not
-  unless (w == w') $
+  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 rootx (wa_x wa) ((wa_x wa) + (wa_width  wa))
-      let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa))
-      io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y)
+      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 w 0 0 0 0
-           (fraction h (wa_width wa)) (fraction v (wa_height wa))
+      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)
 
-moveWithin :: Integral a => a -> a -> a -> a
-moveWithin current lower upper =
-    if current < lower
+windowAttributesToRectangle :: WindowAttributes -> Rectangle
+windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))
+                                           (fi (wa_y wa))
+                                           (fi (wa_width wa + 2 * wa_border_width wa))
+                                           (fi (wa_height wa + 2 * wa_border_width wa))
+moveWithin :: Ord a => a -> a -> a -> a
+moveWithin now lower upper =
+    if now < lower
     then lower
-    else if current > upper
+    else if now > upper
          then upper
-         else current
-
+         else now

XMonad/Actions/Warp.hs

@@ -15,11 +15,13 @@
 module XMonad.Actions.Warp (
                            -- * Usage
                            -- $usage
+                           banish,
+                           banishScreen,
+                           Corner(..),
                            warpToScreen,
                            warpToWindow
                           ) where
 
-import Data.Ratio
 import Data.List
 import XMonad
 import XMonad.StackSet as W
@@ -31,27 +33,54 @@ 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.
-
-'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; you could define:
-
-> banish :: X ()
-> banish = warpToWindow 1 1 -- lower left
-
 -}
 
 -- 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,13 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.WindowBringer (
-                                    -- * Usage
-                                    -- $usage
-                                    gotoMenu, bringMenu, windowMapWith
-                                   ) where
+                    -- * Usage
+                    -- $usage
+                    gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',
+                    bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',
+                    windowMap,
+                    bringWindow
+                   ) where
 
 import Data.Char (toLower)
 import qualified Data.Map as M
@@ -26,7 +29,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 (menuMapArgs)
 import XMonad.Util.NamedWindows (getName)
 
 -- $usage
@@ -37,39 +40,80 @@ 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".
 
+-- | Default menu command
+defaultCmd :: String
+defaultCmd = "dmenu"
 
 -- | 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 = gotoMenuArgs []
+
+-- | Pops open a dmenu with window titles. Choose one, and you will be
+--   taken to the corresponding workspace. This version takes a list of
+--   arguments to pass to dmenu.
+gotoMenuArgs :: [String] -> X ()
+gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace.
+gotoMenu' :: String -> X ()
+gotoMenu' menuCmd = gotoMenuArgs' menuCmd []
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace. This version takes a
+--   list of arguments to pass to dmenu.
+gotoMenuArgs' :: String -> [String] -> X ()
+gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs 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 = bringMenuArgs []
 
--- | 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
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   dragged, kicking and screaming, into your current workspace. This version
+--   takes a list of arguments to pass to dmenu.
+bringMenuArgs :: [String] -> X ()
+bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs
 
--- | 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.
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace.
+bringMenu' :: String -> X ()
+bringMenu' menuCmd = bringMenuArgs' menuCmd []
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace. This version allows arguments to the chooser to be specified.
+bringMenuArgs' :: String -> [String] -> X ()
+bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow
+
+-- | Brings the specified window into the current workspace.
+bringWindow :: Window -> X.WindowSet -> X.WindowSet
+bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
+
+-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
+--   if found.
+actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
+actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
+    where
+      menuMapFunction :: M.Map String a -> X (Maybe a)
+      menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs 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

@@ -10,23 +10,41 @@ Defines a few convenient operations for raising (traveling to) windows based on
 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.
--}
+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 XMonad (Query(), X(), withWindowSet, spawn, runQuery, focus)
-import Control.Monad (filterM)
-import qualified XMonad.StackSet as W (allWindows)
+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@:
@@ -35,52 +53,136 @@ Import the module into your @~\/.xmonad\/xmonad.hs@:
 
 and define appropriate key bindings:
 
-> , ((modMask x .|. shiftMask, xK_g), raise (className =? "Firefox"))
-> , ((modMask x .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox"))
+> , ((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")
 
-(Note that Firefox v3 and up have a class-name of "Firefox" and "Navigator";
-lower versions use other classnames such as "Firefox-bin"
 For detailed instructions on editing your key bindings, see
 "XMonad.Doc.Extending#Editing_key_bindings". -}
 
--- | 'action' is an executable to be run via 'spawn' if the Window cannot be found.
---   Presumably this executable is the same one that you were looking for.
+-- | 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.
+   Note that this does not go through the shell. If you wish to run an arbitrary IO action
+   (such as 'spawn', which will run its String argument through the shell), then you will want to use
+   'raiseMaybe' directly. -}
 runOrRaise :: String -> Query Bool -> X ()
-runOrRaise action = raiseMaybe $ spawn action
+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 three such useful booleans defined in
-   XMonad.ManageHook: title, resource, className. Each one tests based pretty
+   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 declares the class "Firefox", so you'd want to
-   pass in a boolean like '(className =? "Firefox")'.
+   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
+   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
+   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
+   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 "XMonad.Utils.Run"'s 'runInTerm'):
+   (borrowing 'runInTerm' from "XMonad.Utils.Run"):
 
   > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
 -}
 raiseMaybe :: X () -> Query Bool -> X ()
-raiseMaybe f thatUserQuery = withWindowSet $ \s -> do
-    maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s)
-    case maybeResult of
-      []     -> f
-      (x:_)  -> focus 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 argument 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,79 @@
+----------------------------------------------------------------------------
+-- |
+-- 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)
+
+colorizer :: a -> Bool -> X (String, String)
+colorizer _ isFg = do
+    fBC <- asks (focusedBorderColor . config)
+    nBC <- asks (normalBorderColor . config)
+    return $ if isFg
+                then (fBC, nBC)
+                else (nBC, fBC)
+
+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 = (buildDefaultGSConfig colorizer)
+                    { gs_originFractX = originFractX
+                    , gs_originFractY = originFractY }
+        actions = [ ("Cancel menu", return ())
+                  , ("Close"      , kill)
+                  , ("Maximize"   , sendMessage $ maximizeRestore w)
+                  , ("Minimize"   , minimizeWindow 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,215 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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(..), WNState,
+                                       ) 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
+
+-- $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,52 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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.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/WorkspaceCursors.hs

@@ -0,0 +1,222 @@
+{-# 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
+
+    -- * Types
+    Cursors,
+    ) 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/Actions/WorkspaceNames.hs

@@ -0,0 +1,152 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WorkspaceNames
+-- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Tomas Janousek <tomi@nomi.cz>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Provides bindings to rename workspaces, show these names in DynamicLog and
+-- swap workspaces along with their names. These names survive restart.
+-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
+-- dynamic topic space workflow.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.WorkspaceNames (
+    -- * Usage
+    -- $usage
+
+    -- * Workspace naming
+    renameWorkspace,
+    workspaceNamesPP,
+    getWorkspaceNames,
+    setWorkspaceName,
+    setCurrentWorkspaceName,
+
+    -- * Workspace swapping
+    swapTo,
+    swapTo',
+    swapWithCurrent,
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
+import qualified XMonad.Actions.SwapWorkspaces as Swap
+import XMonad.Hooks.DynamicLog (PP(..))
+import XMonad.Prompt (mkXPrompt, XPConfig)
+import XMonad.Prompt.Workspace (Wor(Wor))
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.WorkspaceNames
+--
+-- Then add keybindings like the following:
+--
+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
+--
+-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
+--
+-- > myLogHook =
+-- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
+--
+-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
+-- functionality, which may be used this way:
+--
+-- >   , ((modMask .|. shiftMask, xK_Left  ), swapTo Prev)
+-- >   , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
+--
+-- > [((modm .|. controlMask, k), swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+
+-- | Workspace names container.
+newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
+    deriving (Typeable, Read, Show)
+
+instance ExtensionClass WorkspaceNames where
+    initialValue = WorkspaceNames M.empty
+    extensionType = PersistentExtension
+
+-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
+-- workspaces with a name, and to @\"t\"@ otherwise.
+getWorkspaceNames :: X (WorkspaceId -> String)
+getWorkspaceNames = do
+    WorkspaceNames m <- XS.get
+    return $ \wks -> case M.lookup wks m of
+        Nothing -> wks
+        Just s  -> wks ++ ":" ++ s
+
+-- | Sets the name of a workspace. Empty string makes the workspace unnamed
+-- again.
+setWorkspaceName :: WorkspaceId -> String -> X ()
+setWorkspaceName w name = do
+    WorkspaceNames m <- XS.get
+    XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m
+    refresh
+
+-- | Sets the name of the current workspace. See 'setWorkspaceName'.
+setCurrentWorkspaceName :: String -> X ()
+setCurrentWorkspaceName name = do
+    current <- gets (W.currentTag . windowset)
+    setWorkspaceName current name
+
+-- | Prompt for a new name for the current workspace and set it.
+renameWorkspace :: XPConfig -> X ()
+renameWorkspace conf = do
+    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
+    where pr = Wor "Workspace name: "
+
+-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
+-- workspace names as well.
+workspaceNamesPP :: PP -> X PP
+workspaceNamesPP pp = do
+    names <- getWorkspaceNames
+    return $
+        pp {
+            ppCurrent         = ppCurrent         pp . names,
+            ppVisible         = ppVisible         pp . names,
+            ppHidden          = ppHidden          pp . names,
+            ppHiddenNoWindows = ppHiddenNoWindows pp . names,
+            ppUrgent          = ppUrgent          pp . names
+        }
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
+swapTo :: Direction1D -> X ()
+swapTo dir = swapTo' dir AnyWS
+
+-- | Swap with the previous or next workspace of the given type.
+swapTo' :: Direction1D -> WSType -> X ()
+swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
+-- same with names.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent t = do
+    current <- gets (W.currentTag . windowset)
+    swapNames t current
+    windows $ Swap.swapWorkspaces t current
+
+-- | Swap names of the two workspaces.
+swapNames :: WorkspaceId -> WorkspaceId -> X ()
+swapNames w1 w2 = do
+    WorkspaceNames m <- XS.get
+    let getname w = fromMaybe "" $ M.lookup w m
+        set w name m' = if null name then M.delete w m' else M.insert w name m'
+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m

XMonad/Config/Arossato.hs

@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Config.Arossato
@@ -20,13 +21,12 @@ module XMonad.Config.Arossato
     ) where
 
 import qualified Data.Map as M
-import System.IO (hPutStrLn)
 
 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
@@ -91,8 +91,7 @@ arossatoConfig = do
                                 map show [7 .. 9 :: Int]
          , logHook            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
          , manageHook         = newManageHook
-         , layoutHook         = eventHook ServerMode $
-                                avoidStruts $
+         , layoutHook         = avoidStruts $
                                 decorated        |||
                                 noBorders mytabs |||
                                 otherLays
@@ -100,6 +99,7 @@ arossatoConfig = do
          , normalBorderColor  = "white"
          , focusedBorderColor = "black"
          , keys               = newKeys
+         , handleEventHook    = serverModeEventHook
          , focusFollowsMouse  = False
          }
     where

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 = azertyKeys <+> keys defaultConfig }
+
+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/Bluetile.hs

@@ -0,0 +1,217 @@
+{-# OPTIONS -fno-warn-missing-signatures #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.Bluetile
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This is the default configuration of Bluetile
+-- (<http://projects.haskell.org/bluetile/>). If you
+-- are migrating from Bluetile to xmonad or want to create
+-- a similar setup, then this will give you pretty much
+-- the same thing, except for Bluetile's helper applications
+-- such as the dock.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Config.Bluetile (
+    -- * Usage
+    -- $usage
+    bluetileConfig
+    ) where
+
+import XMonad hiding ( (|||) )
+
+import XMonad.Layout.BorderResize
+import XMonad.Layout.BoringWindows
+import XMonad.Layout.ButtonDecoration
+import XMonad.Layout.Decoration
+import XMonad.Layout.DecorationAddons
+import XMonad.Layout.DraggingVisualizer
+import XMonad.Layout.LayoutCombinators
+import XMonad.Layout.Maximize
+import XMonad.Layout.Minimize
+import XMonad.Layout.MouseResizableTile
+import XMonad.Layout.Named
+import XMonad.Layout.NoBorders
+import XMonad.Layout.PositionStoreFloat
+import XMonad.Layout.WindowSwitcherDecoration
+
+import XMonad.Actions.BluetileCommands
+import XMonad.Actions.CycleWS
+import XMonad.Actions.WindowMenu
+
+import XMonad.Hooks.CurrentWorkspaceOnTop
+import XMonad.Hooks.EwmhDesktops
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Hooks.PositionStoreHooks
+import XMonad.Hooks.Minimize
+import XMonad.Hooks.ServerMode
+import XMonad.Hooks.WorkspaceByPos
+
+import XMonad.Config.Gnome
+
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+
+import System.Exit
+import Data.Monoid
+import Control.Monad(when)
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Bluetile
+-- > import XMonad.Util.Replace
+-- >
+-- > main = replace >> xmonad bluetileConfig
+--
+-- The invocation of 'replace' will replace a currently running
+-- window manager. This is the default behaviour of Bluetile as well.
+-- See "XMonad.Util.Replace" for more information.
+
+bluetileWorkspaces :: [String]
+bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
+
+bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
+bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
+    -- launching and killing programs
+    [ ((modMask'              , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
+    , ((modMask',               xK_p     ), gnomeRun)    --  %! Launch Gnome "Run application" dialog
+    , ((modMask' .|. shiftMask, xK_c     ), kill) -- %! Close the focused window
+
+    , ((modMask',               xK_F5 ), refresh) -- %! Resize viewed windows to the correct size
+    , ((modMask' .|. shiftMask, xK_F5 ), setLayout $ XMonad.layoutHook conf) -- %!  Reset the layouts on the current workspace to default
+
+    , ((modMask',               xK_o ), windowMenu)
+
+    -- move focus up or down the window stack
+    , ((modMask',               xK_Tab   ), focusDown) -- %! Move focus to the next window
+    , ((modMask' .|. shiftMask, xK_Tab   ), focusUp) -- %! Move focus to the previous window
+    , ((modMask',               xK_j     ), focusDown) -- %! Move focus to the next window
+    , ((modMask',               xK_k     ), focusUp) -- %! Move focus to the previous window
+    , ((modMask',               xK_space ), focusMaster) -- %! Move focus to the master window
+
+    -- modifying the window order
+    , ((modMask' .|. shiftMask, xK_space ), windows W.swapMaster) -- %! Swap the focused window and the master window
+    , ((modMask' .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window
+    , ((modMask' .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window
+
+    -- resizing the master/slave ratio
+    , ((modMask',               xK_h     ), sendMessage Shrink) -- %! Shrink the master area
+    , ((modMask',               xK_l     ), sendMessage Expand) -- %! Expand the master area
+    , ((modMask',               xK_u     ), sendMessage ShrinkSlave) -- %! Shrink a slave area
+    , ((modMask',               xK_i     ), sendMessage ExpandSlave) -- %! Expand a slave area
+
+    -- floating layer support
+    , ((modMask',               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling
+    , ((modMask' .|. shiftMask, xK_t     ), withFocused $ float ) -- %! Float window
+
+    -- increase or decrease number of windows in the master area
+    , ((modMask'              , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
+    , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
+
+    -- quit, or restart
+    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit
+    , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart
+
+    -- Metacity-like workspace switching
+    , ((mod1Mask .|. controlMask, xK_Left), prevWS)
+    , ((mod1Mask .|. controlMask, xK_Right), nextWS)
+    , ((mod1Mask .|. controlMask .|. shiftMask,   xK_Left), shiftToPrev >> prevWS)
+    , ((mod1Mask .|. controlMask .|. shiftMask,   xK_Right), shiftToNext >> nextWS)
+
+    -- more Metacity keys
+    , ((mod1Mask             , xK_F2), gnomeRun)
+    , ((mod1Mask             , xK_F4), kill)
+
+    -- Switching to layouts
+    , ((modMask'              , xK_a), sendMessage $ JumpToLayout "Floating")
+    , ((modMask'              , xK_s), sendMessage $ JumpToLayout "Tiled1")
+    , ((modMask'              , xK_d), sendMessage $ JumpToLayout "Tiled2")
+    , ((modMask'              , xK_f), sendMessage $ JumpToLayout "Fullscreen")
+
+    -- Maximizing
+    , ((modMask'              , xK_z), withFocused (sendMessage . maximizeRestore))
+
+    -- Minimizing
+    , ((modMask',               xK_m     ), withFocused minimizeWindow)
+    , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
+    ]
+    ++
+    -- mod-[1..9] ++ [0] %! Switch to workspace N
+    -- mod-shift-[1..9] ++ [0] %! Move client to workspace N
+    [((m .|. modMask', k), windows $ f i)
+        | (i, k) <- zip (XMonad.workspaces conf) ([xK_1 .. xK_9] ++ [xK_0])
+        , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+    ++
+    -- mod-{w,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
+    -- mod-shift-{w,e,r} %! Move client to screen 1, 2, or 3
+    [((m .|. modMask', key), screenWorkspace sc >>= flip whenJust (windows . f))
+        | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
+        , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
+bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
+bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $
+    -- mod-button1 %! Move a floated window by dragging
+    [ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $
+                                focus w >> mouseMoveWindow w >> windows W.shiftMaster))
+    -- mod-button2 %! Switch to next and first layout
+    , ((modMask', button2), (\_ -> sendMessage NextLayout))
+    , ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))
+    -- mod-button3 %! Resize a floated window by dragging
+    , ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $
+                                focus w >> mouseResizeWindow w >> windows W.shiftMaster))
+    ]
+
+isFloating :: Window -> X (Bool)
+isFloating w = do
+    ws <- gets windowset
+    return $ M.member w (W.floating ws)
+
+bluetileManageHook :: ManageHook
+bluetileManageHook = composeAll
+               [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)
+                , className =? "MPlayer" --> doFloat
+                , isFullscreen --> doFullFloat
+                , manageDocks]
+
+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
+                        named "Floating" floating |||
+                        named "Tiled1" tiled1 |||
+                        named "Tiled2" tiled2 |||
+                        named "Fullscreen" fullscreen
+                        )
+        where
+            floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat
+            tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored
+            tiled2 = tilingDeco $ maximize $ mouseResizableTile
+            fullscreen = tilingDeco $ maximize $ smartBorders Full
+
+            tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)
+            floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
+
+bluetileConfig =
+    defaultConfig
+        { modMask = mod4Mask,   -- logo key
+          manageHook = bluetileManageHook,
+          layoutHook = bluetileLayoutHook,
+          logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,
+          handleEventHook = ewmhDesktopsEventHook
+                                `mappend` fullscreenEventHook
+                                `mappend` minimizeEventHook
+                                `mappend` serverModeEventHook' bluetileCommands
+                                `mappend` positionStoreEventHook,
+          workspaces = bluetileWorkspaces,
+          keys = bluetileKeys,
+          mouseBindings = bluetileMouseBindings,
+          focusFollowsMouse = False,
+          focusedBorderColor = "#000000",
+          terminal = "gnome-terminal"
+        }

XMonad/Config/Desktop.hs

@@ -0,0 +1,176 @@
+{-# 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.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 "XMonad.Doc.Extending#Extending xmonad".
+
+-- $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:
+--
+-- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig
+--
+-- or 'mconcat' if you write a list event of event hooks
+--
+-- >  , handleEventHook = mconcat
+-- >        [ myMouseHandler
+-- >        , myMessageHandler
+-- >        , handleEventHook desktopConfig ]
+--
+-- Note that the event hooks are run left to right (in contrast to
+-- 'ManageHook'S which are right to left)
+
+-- $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            = desktopKeys <+> keys defaultConfig }
+
+desktopKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_b), sendMessage ToggleStruts) ]
+
+desktopLayoutModifiers layout = avoidStruts layout
+

XMonad/Config/Dons.hs

@@ -1,28 +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
-import XMonad.Layout.NoBorders
-
-donsMain :: IO ()
-donsMain = dzen $ \x -> xmonad $ x
-        { terminal           = "term"
-        , normalBorderColor  = "#333333"
-        , focusedBorderColor = "red"
-        , layoutHook         = smartBorders (layoutHook x)
-        , manageHook         =
-                manageHook x <+>
-                    (className =? "Toplevel" --> doFloat)
-        }

XMonad/Config/Droundy.hs

@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Copyright   :  (c) Spencer Janssen 2007
@@ -10,7 +11,6 @@ module XMonad.Config.Droundy ( config, mytab ) where
 
 import XMonad hiding (keys, config, (|||))
 import qualified XMonad (keys)
-import XMonad.Config ( defaultConfig )
 
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M
@@ -21,15 +21,16 @@ import XMonad.Layout.Tabbed ( tabbed, defaultTheme,
 import XMonad.Layout.Combo ( combineTwo )
 import XMonad.Layout.Named ( named )
 import XMonad.Layout.LayoutCombinators
-import XMonad.Layout.Simplest ( Simplest(Simplest) )
 import XMonad.Layout.Square ( Square(Square) )
-import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L),
+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.ScratchWorkspace ( toggleScratchWorkspace )
+import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
 
 import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )
 import XMonad.Prompt.Layout ( layoutPrompt )
@@ -39,11 +40,10 @@ import XMonad.Actions.CopyWindow ( kill1, copy )
 import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
                                           selectWorkspace, renameWorkspace, removeWorkspace )
 import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
-                                WSDirection( Prev, Next) )
+                                Direction1D( Prev, Next) )
 
 import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
-import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,
-                                   ewmhDesktopsLayout )
+import XMonad.Hooks.EwmhDesktops ( ewmh )
 
 myXPConfig :: XPConfig
 myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
@@ -62,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
@@ -94,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)
@@ -106,22 +108,21 @@ keys x = M.fromList $
     , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)
     , ((modMask x, xK_l ), layoutPrompt myXPConfig)
     , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
-    , ((modMask x .|. controlMask .|. shiftMask, xK_space),
-       toggleScratchWorkspace (Simplest */* Simplest) )
+    , ((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 = defaultConfig
+config = ewmh defaultConfig
          { borderWidth = 1 -- Width of the window border in pixels.
          , XMonad.workspaces = ["mutt","iceweasel"]
-         , layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $
-                        smartBorders $ windowNavigation $
-                        toggleLayouts Full $ avoidStruts $
+         , 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) |||
@@ -129,9 +130,8 @@ config = defaultConfig
                                                 ****//* combineTwo Square mytab mytab) --   |||
                         --mosaic 0.25 0.5
          , manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
-         , logHook = ewmhDesktopsLogHook -- actually, no logging here, just other stuff
          , 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
@@ -140,12 +140,12 @@ config = defaultConfig
 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
@@ -174,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     = gnomeKeys <+> keys desktopConfig
+    , 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     = kdeKeys <+> keys desktopConfig }
+
+kde4Config = desktopConfig
+    { terminal = "konsole"
+    , keys     = kde4Keys <+> keys desktopConfig }
+
+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

@@ -6,41 +6,59 @@ import qualified XMonad.StackSet as W
 import XMonad.Actions.CopyWindow
 import XMonad.Layout.Tabbed
 import XMonad.Layout.HintedTile
-import XMonad.Config (defaultConfig)
 import XMonad.Layout.NoBorders
 import XMonad.Hooks.DynamicLog
 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.Util.SpawnOnce
+
+import XMonad.Layout.LayoutScreens
+import XMonad.Layout.TwoPane
 
 import qualified Data.Map as M
-import System.IO (hPutStrLn)
 
-sjanssenConfig = do
-    xmobar <- spawnPipe "xmobar"
-    return $ defaultConfig
-        { terminal = "urxvtc"
-        , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]
-        , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }
-        , modMask = mod4Mask
+sjanssenConfig =
+    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 myTheme)
-        , manageHook = manageHook defaultConfig <+> manageDocks
+        , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
+        , layoutHook  = modifiers layouts
+        , manageHook  = composeAll [className =? x --> doShift w
+                                    | (x, w) <- [ ("Firefox", "web")
+                                                , ("Ktorrent", "7")
+                                                , ("Amarokapp", "7")]]
+                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
+                        <+> (isFullscreen --> doFullFloat)
+        , startupHook = mapM_ spawnOnce spawns
         }
  where
-    tiled   = HintedTile 1 0.03 0.5 TopLeft
+    tiled     = HintedTile 1 0.03 0.5 TopLeft
+    layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
+    modifiers = avoidStruts . smartBorders
 
-    mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
-        [((modm,               xK_p     ), shellPrompt myPromptConfig)
+    spawns = [ "xmobar"
+             , "xset -b", "xset s off", "xset dpms 0 600 1200"
+             , "nitrogen --set-tiled wallpaper/wallpaper.jpg"
+             , "trayer --transparent true --expand true --align right "
+               ++ "--edge bottom --widthtype request" ]
+
+    mykeys (XConfig {modMask = modm}) = M.fromList $
+        [((modm,               xK_p     ), shellPromptHere myPromptConfig)
+        ,((modm .|. shiftMask, xK_Return), spawnHere =<< 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)
+        , ((modm             , xK_b     ), sendMessage ToggleStruts)
         ]
 
     myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
@@ -48,4 +66,6 @@ sjanssenConfig = do
     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     = xfceKeys <+> keys desktopConfig }
+
+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

@@ -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
-(Mar. 2008) tarball here:
-<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.7>
+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, you should NOT edit this file.  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
@@ -90,8 +99,8 @@ describe values that differ from the defaults.
 
 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 at
-@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_xmonad.hs@)
+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.
@@ -106,18 +115,14 @@ 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.2: 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
@@ -139,15 +144,8 @@ 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

@@ -211,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
@@ -253,21 +253,25 @@ xmonad contributed extensions.
 
 * 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.
+
+* Code should be free of any warnings or errors from the Hlint tool; use your
+  best judgement on some warnings like eta-reduction or bracket removal, though.
 
 * 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.
+  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
@@ -286,7 +290,7 @@ To generate and view the Haddock documentation for your extension, run
 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/haddock-html-0.8/index.html>.
+<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:

XMonad/Hooks/CurrentWorkspaceOnTop.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.CurrentWorkspaceOnTop
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Ensures that the windows of the current workspace are always in front
+-- of windows that are located on other visible screens. This becomes important
+-- if you use decoration and drag windows from one screen to another. Using this
+-- module, the dragged window will always be in front of other windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.CurrentWorkspaceOnTop (
+    -- * Usage
+    -- $usage
+    currentWorkspaceOnTop
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad(when)
+import qualified Data.Map as M
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.CurrentWorkspaceOnTop
+-- >
+-- > main = xmonad $ defaultConfig {
+-- >    ...
+-- >    logHook = currentWorkspaceOnTop
+-- >    ...
+-- >  }
+--
+
+data CWOTState = CWOTS String deriving Typeable
+
+instance ExtensionClass CWOTState where
+  initialValue = CWOTS ""
+
+currentWorkspaceOnTop :: X ()
+currentWorkspaceOnTop = withDisplay $ \d -> do
+    ws <- gets windowset
+    (CWOTS lastTag) <- XS.get
+    let curTag = S.tag . S.workspace . S.current $ ws
+    when (curTag /= lastTag) $ do
+        -- the following is more or less a reimplementation of what's happening in "XMonad.Operation"
+        let s = S.current ws
+            wsp = S.workspace s
+            viewrect = screenRect $ S.screenDetail s
+            tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)
+        (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
+        updateLayout curTag ml'
+        let this = S.view curTag ws
+            fltWins = filter (flip M.member (S.floating ws)) $ S.index this
+            wins = fltWins ++ (map fst rs)  -- order: first all floating windows, then the order the layout returned
+        -- end of reimplementation
+
+        when (not . null $ wins) $ do
+            io $ raiseWindow d (head wins)  -- raise first window of current workspace to the very top,
+            io $ restackWindows d wins      -- then use restackWindows to let all other windows from the workspace follow
+        XS.put(CWOTS curTag)

XMonad/Hooks/DebugKeyEvents.hs

@@ -0,0 +1,107 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.DebugKeyEvents
+-- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Brandon S Allbery <allbery.b@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- A debugging module to track key events, useful when you can't tell whether
+-- xmonad is processing some or all key events.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugKeyEvents (-- * Usage
+                                    -- $usage
+                                    debugKeyEvents
+                                   ) where
+
+import           XMonad.Core
+import           XMonad.Operations               (cleanMask)
+
+import           Graphics.X11.Xlib
+import           Graphics.X11.Xlib.Extras
+
+import           Control.Monad.State             (gets)
+import           Data.Bits
+import           Data.List                       (intercalate)
+import           Data.Monoid
+import           Numeric                         (showHex)
+import           System.IO                       (hPutStrLn
+                                                 ,stderr)
+
+-- $usage
+-- Add this to your handleEventHook to print received key events to the
+-- log (the console if you use @startx@/@xinit@, otherwise usually
+-- @~/.xsession-errors@).
+--
+-- >      , handleEventHook = debugKeyEvents
+--
+-- If you already have a handleEventHook then you should append it:
+--
+-- >      , handleEventHook = ... <+> debugKeyEvents
+--
+-- Logged key events look like:
+--
+-- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@
+-- 
+-- The @mask@ and @clean@ indicate the modifiers pressed along with
+-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after
+-- sanitizing it (removing @numberLockMask@, etc.)
+--
+-- For more detailed instructions on editing the logHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+
+-- | Print key events to stderr for debugging
+debugKeyEvents :: Event -> X All
+debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
+  | t == keyPress =
+      withDisplay $ \dpy -> do
+        sym <- io $ keycodeToKeysym dpy code 0
+        msk <- cleanMask m
+        nl <- gets numberlockMask
+        io $ hPutStrLn stderr $ intercalate " " ["keycode"
+                                                ,show code
+                                                ,"sym"
+                                                ,show sym
+                                                ," ("
+                                                ,hex sym
+                                                ," \""
+                                                ,keysymToString sym
+                                                ,"\") mask"
+                                                ,hex m
+                                                ,"(" ++ vmask nl m ++ ")"
+                                                ,"clean"
+                                                ,hex msk
+                                                ,"(" ++ vmask nl msk ++ ")"
+                                                ]
+        return (All True)
+debugKeyEvents _ = return (All True)
+
+-- | Convenient showHex variant
+hex :: (Integral n, Show n) => n -> String
+hex v = "0x" ++ showHex v ""
+
+-- | Convert a modifier mask into a useful string
+vmask                 :: KeyMask -> KeyMask -> String
+vmask numLockMask msk =  intercalate " " $
+                         reverse $
+                         fst $
+                         foldr vmask' ([],msk) masks
+    where
+      masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] ++
+              [(numLockMask,"num"  )
+              ,(   lockMask,"lock" )
+              ,(controlMask,"ctrl" )
+              ,(  shiftMask,"shift")
+              ,(   mod5Mask,"mod5" )
+              ,(   mod4Mask,"mod4" )
+              ,(   mod3Mask,"mod3" )
+              ,(   mod2Mask,"mod2" )
+              ,(   mod1Mask,"mod1" )
+              ]
+      vmask'   _   a@( _,0)                = a
+      vmask' (m,s)   (ss,v) | v .&. m == m = (s:ss,v .&. complement m)
+      vmask'   _        r                  = r

XMonad/Hooks/DynamicHooks.hs

@@ -0,0 +1,93 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- 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
+  dynamicMasterHook
+  ,addDynamicHook
+  ,updateDynamicHook
+  ,oneShotHook
+  ) where
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+
+import Data.List
+import Data.Maybe (listToMaybe)
+import Data.Monoid
+
+-- $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@.
+--
+-- To use this module, add 'dynamicMasterHook' to your 'manageHook':
+--
+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook }
+--
+-- You can then use the supplied functions in your keybindings:
+--
+-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat)
+--
+
+data DynamicHooks = DynamicHooks
+    { transients :: [(Query Bool, ManageHook)]
+    , permanent  :: ManageHook }
+                    deriving Typeable
+
+instance ExtensionClass DynamicHooks where
+    initialValue = DynamicHooks [] idHook
+
+-- this hook is always executed, and the contents of the stored hooks 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 :: ManageHook
+dynamicMasterHook = (ask >>= \w -> liftX (do
+  dh <- XS.get
+  (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
+  XS.put $ dh { transients = map snd nts }
+  return $ Endo $ f . g
+                                       ))
+-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
+addDynamicHook :: ManageHook -> X ()
+addDynamicHook m = updateDynamicHook (<+> m)
+
+-- | Modifies the permanent 'ManageHook' with an arbitrary function.
+updateDynamicHook :: (ManageHook -> ManageHook) -> X ()
+updateDynamicHook f = XS.modify $ \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 :: Query Bool -> ManageHook -> X ()
+oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }

XMonad/Hooks/DynamicLog.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE FlexibleContexts #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DynamicLog
@@ -22,19 +24,26 @@ module XMonad.Hooks.DynamicLog (
 
     -- * Drop-in loggers
     dzen,
+    xmobar,
+    statusBar,
     dynamicLog,
-    dynamicLogDzen,
-    dynamicLogXmobar,
     dynamicLogXinerama,
 
+    xmonadPropLog',
+    xmonadPropLog,
+
     -- * Build your own formatter
     dynamicLogWithPP,
     dynamicLogString,
-    PP(..), defaultPP, dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
+    PP(..), defaultPP,
+
+    -- * Example formatters
+    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
 
     -- * Formatting utilities
-    wrap, pad, shorten,
-    xmobarColor, dzenColor, dzenEscape,
+    wrap, pad, trim, shorten,
+    xmobarColor, xmobarStrip,
+    dzenColor, dzenEscape, dzenStrip,
 
     -- * Internal formatting functions
     pprWindowSet,
@@ -45,19 +54,28 @@ module XMonad.Hooks.DynamicLog (
 
   ) where
 
---
 -- Useful imports
---
-import XMonad
+
+import Codec.Binary.UTF8.String (encodeString)
+import Control.Monad (liftM2)
+import Data.Char ( isSpace, ord )
+import Data.List (intersperse, isPrefixOf, sortBy)
 import Data.Maybe ( isJust, catMaybes )
-import Data.List
 import Data.Ord ( comparing )
+import qualified Data.Map as M
 import qualified XMonad.StackSet as S
-import System.IO
+
+import Foreign.C (CChar)
+
+import XMonad
+
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.NamedWindows
 import XMonad.Util.Run
+
+import XMonad.Layout.LayoutModifier
 import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.ManageDocks
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -66,18 +84,19 @@ import XMonad.Hooks.UrgencyHook
 -- >    import XMonad.Hooks.DynamicLog
 --
 -- If you just want a quick-and-dirty status bar with zero effort, try
--- the 'dzen' function, which sets up a dzen status bar with a default
--- format:
+-- the 'xmobar' or 'dzen' functions:
 --
--- > main = dzen xmonad
+-- > main = xmonad =<< xmobar myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
 --
--- or, to use this with your own custom xmonad configuration,
+-- 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!
 --
--- > main = dzen $ \conf -> xmonad $ conf { <your customizations> }
---
--- Alternatively, you can choose among several default status bar
--- formats ('dynamicLog', 'dynamicLogDzen', 'dynamicLogXmobar', or
--- 'dynamicLogXinerama') by simply setting your logHook to the
+-- 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 {
@@ -101,6 +120,8 @@ import XMonad.Hooks.UrgencyHook
 -- 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 {
@@ -126,31 +147,93 @@ import XMonad.Hooks.UrgencyHook
 --
 --   * add an xmobarEscape function
 
--- | Run xmonad with a dzen status bar set to some nice defaults. Output
--- is taken from the dynamicLogWithPP hook.
+------------------------------------------------------------------------
+
+-- | Run xmonad with a dzen status bar set to some nice defaults.
 --
--- > main = dzen xmonad
+-- > main = xmonad =<< dzen myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
 --
 -- The intent is that the above config file should provide a nice
--- status bar with minimal effort.  If you want to customize your xmonad
--- configuration while using this, you'll have to do something like
---
--- > main = dzen $ \conf -> xmonad $ conf { <your customized settings...> }
+-- status bar with minimal effort.
 --
 -- If you wish to customize the status bar format at all, you'll have to
--- use something like 'dynamicLogWithPP' instead.
+-- 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 myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
+--
+-- 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
+
+-- | Write a string to a property on the root window.  This property is of
+-- type UTF8_STRING. The string must have been processed by encodeString
+-- (dynamicLogString does this).
+xmonadPropLog' :: String -> String -> X ()
+xmonadPropLog' prop msg = do
+    d <- asks display
+    r <- asks theRoot
+    xlog <- getAtom prop
+    ustring <- getAtom "UTF8_STRING"
+    io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)
+ where
+    encodeCChar :: String -> [CChar]
+    encodeCChar = map (fromIntegral . ord)
+
+-- | Write a string to the _XMONAD_LOG property on the root window.
+xmonadPropLog :: String -> X ()
+xmonadPropLog = xmonadPropLog' "_XMONAD_LOG"
+
+-- |
+-- 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:
@@ -165,16 +248,6 @@ dzen f = do
 dynamicLog :: X ()
 dynamicLog = dynamicLogWithPP defaultPP
 
--- | 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
-
--- | These are good defaults to be used with the xmobar status bar.
-dynamicLogXmobar :: X ()
-dynamicLogXmobar = dynamicLogWithPP xmobarPP
-
 -- | Format the current status using the supplied pretty-printing format,
 --   and write it to stdout.
 dynamicLogWithPP :: PP -> X ()
@@ -201,9 +274,9 @@ dynamicLogString pp = do
     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
+    extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp
 
-    return $ sepBy (ppSep pp) . ppOrder pp $
+    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
                         [ ws
                         , ppLayout pp ld
                         , ppTitle  pp wt
@@ -216,13 +289,13 @@ dynamicLogString pp = do
 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.tag (S.workspace (S.current 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
+          where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent
+                        | 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
 
@@ -234,10 +307,15 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
 -- 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.
 --
--- 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.
+-- At the present time, the current layout and window title
+-- are not shown.  The xinerama workspace format shown above can be (mostly) replicated
+-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from
+-- "XMonad.Util.WorkspaceCompare".  For example,
+--
+-- > defaultPP { ppCurrent = dzenColor "red" "#efebe7"
+-- >           , ppVisible = wrap "[" "]"
+-- >           , ppSort    = getSortByXineramaRule
+-- >           }
 dynamicLogXinerama :: X ()
 dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
 
@@ -260,10 +338,15 @@ wrap l r m  = l ++ m ++ r
 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
+             | otherwise     = take (n - length end) xs ++ end
  where
     end = "..."
 
@@ -290,6 +373,16 @@ dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)
 dzenEscape :: String -> String
 dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
 
+-- | Strip dzen formatting or commands.
+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
@@ -301,6 +394,17 @@ xmobarColor fg bg = wrap t "</fc>"
 
 -- ??? add an xmobarEscape function?
 
+-- | Strip xmobar markup.
+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
@@ -316,8 +420,6 @@ data PP = PP { ppCurrent :: 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)
@@ -376,35 +478,36 @@ defaultPP = PP { ppCurrent         = wrap "[" "]"
 -- | Settings to emulate dwm's statusbar, dzen only.
 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"
-                     , ppWsSep    = ""
-                     , ppSep      = ""
-                     , ppLayout   = dzenColor "black" "#cccccc" .
-                                    (\ x -> case x of
-                                              "TilePrime Horizontal" -> " TTT "
-                                              "TilePrime Vertical"   -> " []= "
-                                              "Hinted Full"          -> " [ ] "
-                                              _                      -> pad x
-                                    )
-                     , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
-                     }
+                   , ppVisible  = dzenColor "black" "#999999" . pad
+                   , ppHidden   = dzenColor "black" "#cccccc" . pad
+                   , ppHiddenNoWindows = const ""
+                   , ppUrgent   = dzenColor "red" "yellow" . pad
+                   , ppWsSep    = ""
+                   , ppSep      = ""
+                   , ppLayout   = dzenColor "black" "#cccccc" .
+                                  (\ x -> pad $ case x of
+                                            "TilePrime Horizontal" -> "TTT"
+                                            "TilePrime Vertical"   -> "[]="
+                                            "Hinted Full"          -> "[ ]"
+                                            _                      -> x
+                                  )
+                   , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
+                   }
 
 -- | 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
                        }
 
 -- | The options that byorgey likes to use with dzen, as another example.
@@ -412,7 +515,7 @@ byorgeyPP :: PP
 byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
                       , ppHidden  = dzenColor "black"  "#a8a3f7" . pad
                       , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
-                      , ppUrgent  = dzenColor "red"    "yellow"
+                      , ppUrgent  = dzenColor "red"    "yellow"  . pad
                       , ppSep     = " | "
                       , ppWsSep   = ""
                       , ppTitle   = shorten 70
@@ -421,4 +524,3 @@ byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
   where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']
                                        then pad wsId
                                        else ""
-

XMonad/Hooks/EventHook.hs

@@ -1,108 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Hooks.EventHook
--- Copyright   :  (c) 2007 Andrea Rossato
--- License     :  BSD-style (see xmonad/LICENSE)
---
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout modifier that implements an event hook at the layout level.
---
--- Since it operates at the 'Workspace' level, it will install itself
--- on the first current 'Workspace' and will broadcast a 'Message' to
--- all other 'Workspace's not to handle events.
------------------------------------------------------------------------------
-
-module XMonad.Hooks.EventHook
-    ( -- * Usage
-      -- $usage
-
-      -- * Writing a hook
-      -- $hook
-      EventHook (..)
-    , eventHook
-    , HandleEvent
-    ) where
-
-import Control.Applicative ((<$>))
-import Data.Maybe
-
-import XMonad
-import XMonad.StackSet (StackSet (..), Screen (..), Workspace (..))
-
--- $usage
--- You can use this module with the following in your
--- @~\/.xmonad\/xmonad.hs@:
---
--- > import XMonad.Hooks.EventHook
---
--- Then edit your @layoutHook@ by adding the 'eventHook':
---
--- > layoutHook = eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc..
---
--- and then:
---
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
---
--- For more detailed instructions on editing the layoutHook see:
---
--- "XMonad.Doc.Extending#Editing_the_layout_hook"
-
--- $hook
--- Writing a hook is very simple.
---
--- This is a basic example to log all events:
---
--- > data EventHookExample = EventHookExample deriving ( Show, Read )
--- > instance EventHook EventHookExample where
--- >     handleEvent _ e = io $ hPutStrLn stderr . show $ e --return ()
---
--- This is an 'EventHook' to log mouse button events:
---
--- > data EventHookButton = EventHookButton deriving ( Show, Read )
--- > instance EventHook EventHookButton where
--- >    handleEvent _ (ButtonEvent {ev_window = w}) = do
--- >         io $ hPutStrLn stderr $ "This is a button event on window " ++ (show w)
--- >    handleEvent _ _ = return ()
---
--- Obviously you can compose event hooks:
---
--- > layoutHook = eventHook EventHookButton $ eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc..
-
-eventHook :: EventHook eh => eh -> l a -> (HandleEvent eh l) a
-eventHook = HandleEvent Nothing True
-
-class (Read eh, Show eh) => EventHook eh where
-    handleEvent :: eh -> Event -> X ()
-    handleEvent _ _ = return ()
-
-data HandleEvent eh l a = HandleEvent (Maybe WorkspaceId) Bool eh (l a) deriving ( Show, Read )
-
-data EventHandleMsg = HandlerOff deriving ( Typeable )
-instance Message EventHandleMsg
-
-instance (EventHook eh, LayoutClass l a) => LayoutClass (HandleEvent eh l) a where
-    runLayout (Workspace i (HandleEvent Nothing True eh l) ms) r = do
-      broadcastMessage HandlerOff
-      iws       <- (tag . workspace . current) <$> gets windowset
-      (wrs, ml) <- runLayout (Workspace i l ms) r
-      return (wrs, Just $ HandleEvent (Just iws) True eh (fromMaybe l ml))
-
-    runLayout (Workspace i (HandleEvent mi b eh l) ms) r = do
-      (wrs, ml) <- runLayout (Workspace i l ms) r
-      return (wrs, Just $ HandleEvent mi b eh (fromMaybe l ml))
-
-    handleMessage (HandleEvent i True eh l) m
-        | Just HandlerOff <- fromMessage m = return . Just $ HandleEvent i False eh l
-        | Just e          <- fromMessage m = handleMessage l (SomeMessage e) >>= \ml ->
-                                             handleEvent eh e >>
-                                             maybe (return Nothing) (\l' -> return . Just $ HandleEvent i True eh l') ml
-    handleMessage (HandleEvent i b eh l) m = handleMessage l m >>=
-                                             maybe (return Nothing) (\l' -> return . Just $ HandleEvent i b    eh l')
-
-    description (HandleEvent _ _ _ l) = description l

XMonad/Hooks/EwmhDesktops.hs

@@ -15,20 +15,27 @@
 module XMonad.Hooks.EwmhDesktops (
     -- * Usage
     -- $usage
+    ewmh,
+    ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
-    ewmhDesktopsLayout
+    ewmhDesktopsLogHookCustom,
+    ewmhDesktopsEventHook,
+    fullscreenEventHook
     ) where
 
+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.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
-import XMonad.Hooks.EventHook
+import XMonad.Util.WindowProperties (getProp32)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -36,32 +43,36 @@ import XMonad.Hooks.EventHook
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > myLogHook :: X ()
--- > myLogHook = do ewmhDesktopsLogHook
--- >                return ()
--- >
--- > layoutHook = ewmhDesktopsLayout $ avoidStruts $ simpleTabbed ||| Full ||| etc..
--- >
--- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
+-- > main = xmonad $ ewmh defaultConfig
 --
--- 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"
+-- 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
+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 = sort' $ W.workspaces s
-    let wins = W.allWindows s
-
-    setSupported
+    let ws = f $ sort' $ W.workspaces s
 
     -- Number of Workspaces
     setNumberOfDesktops (length ws)
@@ -69,24 +80,28 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
     -- Names thereof
     setDesktopNames (map W.tag ws)
 
-    -- Current desktop
-    let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws
-
-    setCurrentDesktop curr
-
+    -- 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
-    -- 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
+    -- 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 ->
-        let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in
-        forM_ (W.integrate' (W.stack w)) $ \win -> do
-            setWindowDesktop win wn
+        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
 
@@ -100,15 +115,10 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
 --
 --  * _NET_WM_DESKTOP (move windows to other desktops)
 --
---  * _NET_ACTIVE_WINDOW (activate another window)
+--  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
 --
-ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a
-ewmhDesktopsLayout = eventHook EwmhDesktopsHook
-
-data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read )
-instance EventHook EwmhDesktopsHook where
-	handleEvent _ e@ClientMessageEvent {} = do handle e
-	handleEvent _ _ = return ()
+ewmhDesktopsEventHook :: Event -> X All
+ewmhDesktopsEventHook e = handle e >> return (All True)
 
 handle :: Event -> X ()
 handle ClientMessageEvent {
@@ -122,21 +132,60 @@ handle ClientMessageEvent {
        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))
+               let n = head d
+               if 0 <= n && fi n < length ws then
+                       windows $ W.view (W.tag (ws !! fi 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
+               let n = head d
+               if 0 <= n && fi n < length ws then
+                       windows $ W.shiftWin (W.tag (ws !! fi n)) w
                  else  trace $ "Bad _NET_DESKTOP with data[0]="++show n
         else if mt == a_aw then do
                windows $ W.focusWindow w
-        else trace $ "Unknown ClientMessageEvent " ++ show mt
-handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match
+        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 ()
 
+-- |
+-- An event hook to handle applications that wish to fullscreen using the
+-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
+-- function, such as Totem, Evince and OpenOffice.org.
+fullscreenEventHook :: Event -> X All
+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+  state <- getAtom "_NET_WM_STATE"
+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+  wstate <- fromMaybe [] `fmap` getProp32 state win
+
+  let isFull = fromIntegral fullsc `elem` wstate
+
+      -- Constants for the _NET_WM_STATE protocol:
+      remove = 0
+      add = 1
+      toggle = 2
+      ptype = 4 -- The atom property type for changeProperty
+      chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)
+
+  when (typ == state && fi fullsc `elem` dats) $ do
+    when (action == add || (action == toggle && not isFull)) $ do
+      chWstate (fi fullsc:)
+      windows $ W.float win $ W.RationalRect 0 0 1 1
+    when (action == remove || (action == toggle && isFull)) $ do
+      chWstate $ delete (fi fullsc)
+      windows $ W.sink win
+
+  return $ All True
+
+fullscreenEventHook _ = return $ All True
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do
@@ -158,8 +207,7 @@ setDesktopNames names = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_DESKTOP_NAMES"
     c <- getAtom "UTF8_STRING"
-    let names' = map (fromIntegral.fromEnum) $
-            concatMap (++['\0']) names
+    let names' = map fromIntegral $ concatMap ((++[0]) . encode) names
     io $ changeProperty8 dpy r a c propModeReplace names'
 
 setClientList :: [Window] -> X ()
@@ -199,7 +247,7 @@ setSupported = withDisplay $ \dpy -> do
 
 setActiveWindow :: X ()
 setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
-    let w = fromMaybe 0 (W.peek s)
+    let w = fromMaybe none (W.peek s)
     r <- asks theRoot
     a <- getAtom "_NET_ACTIVE_WINDOW"
     c <- getAtom "WINDOW"

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 logHook 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/FadeWindows.hs

@@ -0,0 +1,221 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.FadeWindows
+-- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>
+-- License     :  BSD
+--
+-- Maintainer  :  Brandon S Allbery KF8NH
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A more flexible and general compositing interface than FadeInactive.
+-- Windows can be selected and opacity specified by means of FadeHooks,
+-- which are very similar to ManageHooks and use the same machinery.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.FadeWindows (-- * Usage
+                                 -- $usage
+
+                                 -- * The 'logHook' for window fading
+                                 fadeWindowsLogHook
+
+                                 -- * The 'FadeHook'
+                                ,FadeHook
+                                ,Opacity
+                                ,idFadeHook
+
+                                 -- * Predefined 'FadeHook's
+                                ,opaque
+                                ,solid
+                                ,transparent
+                                ,invisible
+                                ,transparency
+                                ,translucence
+                                ,fadeBy
+                                ,opacity
+                                ,fadeTo
+
+                                -- * 'handleEventHook' for mapped/unmapped windows
+                                ,fadeWindowsEventHook
+
+                                -- * 'doF' for simple hooks
+                                ,doS
+
+                                -- * Useful 'Query's for 'FadeHook's
+                                ,isFloating
+                                ,isUnfocused
+                                ) where
+
+import           XMonad.Core
+import           XMonad.ManageHook                       (liftX)
+import qualified XMonad.StackSet             as W
+
+import           XMonad.Hooks.FadeInactive               (setOpacity
+                                                         ,isUnfocused
+                                                         )
+
+import           Control.Monad                           (forM_)
+import           Control.Monad.Reader                    (ask
+                                                         ,asks)
+import           Control.Monad.State                     (gets)
+import qualified Data.Map                    as M
+import           Data.Monoid
+
+import           Graphics.X11.Xlib.Extras                (Event(..))
+
+-- $usage
+-- To use this module, make sure your @xmonad@ core supports generalized
+-- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then
+-- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your
+-- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':
+--
+-- >     , logHook = fadeWindowsLogHook myFadeHook
+-- >     , handleEventHook = fadeWindowsEventHook
+-- >     {- ... -}
+-- >
+-- > myFadeHook = composeAll [isUnfocused --> transparency 0.2
+-- >                         ,                opaque
+-- >                         ]
+--
+-- The above is like FadeInactive with a fade value of 0.2.
+--
+-- FadeHooks do not accumulate; instead, they compose from right to
+-- left like 'ManageHook's, so the above example @myFadeHook@ will
+-- render unfocused windows at 4/5 opacity and the focused window
+-- as opaque.  The 'opaque' hook above is optional, by the way, as any
+-- unmatched window will be opaque by default.
+--
+-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
+-- exports a number of Queries that can be used in either @ManageHook@
+-- or @FadeHook@.
+--
+-- Note that you need a compositing manager such as @xcompmgr@,
+-- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you
+-- aren't running a compositing manager, the opacity will be recorded
+-- but won't take effect until a compositing manager is started.
+--
+-- For more detailed instructions on editing the 'logHook' see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the 'handleEventHook',
+-- see:
+--
+-- "XMonad.Doc.Extending#Editing_the_event_hook"
+-- (which sadly doesnt exist at the time of writing...)
+-- 
+-- /WARNING:/  This module is very good at triggering bugs in
+-- compositing managers.  Symptoms range from windows not being
+-- repainted until the compositing manager is restarted or the
+-- window is unmapped and remapped, to the machine becoming sluggish
+-- until the compositing manager is restarted (at which point a
+-- popup/dialog will suddenly appear; apparently it's getting into
+-- a tight loop trying to fade the popup in).  I find it useful to
+-- have a key binding to restart the compositing manager; for example,
+--
+-- main = xmonad $ defaultConfig {
+--                   {- ... -}
+--                 }
+--                 `additionalKeysP`
+--                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]
+--                 {- ... -}
+--                 ]
+--
+-- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)
+
+-- a window opacity to be carried in a Query.  OEmpty is sort of a hack
+-- to make it obay the monoid laws
+data Opacity = Opacity Rational | OEmpty
+
+instance Monoid Opacity where
+  mempty                  = OEmpty
+  r      `mappend` OEmpty = r
+  _      `mappend` r      = r
+
+-- | A FadeHook is similar to a ManageHook, but records window opacity.
+type FadeHook = Query Opacity
+
+-- | Render a window fully opaque.
+opaque :: FadeHook
+opaque =  doS (Opacity 1)
+
+-- | Render a window fully transparent.
+transparent :: FadeHook
+transparent =  doS (Opacity 0)
+
+-- | Specify a window's transparency.
+transparency :: Rational -- ^ The window's transparency as a fraction.
+                         --   @transparency 1@ is the same as 'transparent',
+                         --   whereas @transparency 0@ is the same as 'opaque'.
+             -> FadeHook
+transparency =  doS . Opacity . (1-) . clampRatio
+
+-- | Specify a window's opacity; this is the inverse of 'transparency'.
+opacity :: Rational -- ^ The opacity of a window as a fraction.
+                    --   @opacity 1@ is the same as 'opaque',
+                    --   whereas @opacity 0@ is the same as 'transparent'.
+        -> FadeHook
+opacity =  doS . Opacity . clampRatio
+
+fadeTo, translucence, fadeBy :: Rational -> FadeHook
+-- ^ An alias for 'transparency'.
+fadeTo       = transparency
+-- ^ An alias for 'transparency'.
+translucence = transparency
+-- ^ An alias for 'transparency'.
+fadeBy       = opacity
+
+invisible, solid :: FadeHook
+-- ^ An alias for 'transparent'.
+invisible    = transparent
+-- ^ An alias for 'opaque'.
+solid        = opaque
+
+-- | Like 'doF', but usable with 'ManageHook'-like hooks that
+-- aren't 'Query' wrapped around transforming functions ('Endo').
+doS :: Monoid m => m -> Query m
+doS =  return
+
+-- | The identity 'FadeHook', which renders windows 'opaque'.
+idFadeHook :: FadeHook
+idFadeHook =  opaque
+
+-- | A Query to determine if a window is floating.
+isFloating :: Query Bool
+isFloating =  ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
+
+-- boring windows can't be seen outside of a layout, so we watch messages with
+-- a dummy LayoutModifier and stow them in a persistent bucket.  this is not
+-- entirely reliable given that boringAuto still isn't observable; we just hope
+-- those aren't visible and won;t be affected anyway
+-- @@@ punted for now, will be a separate module.  it's still slimy, though
+
+-- | A 'logHook' to fade windows under control of a 'FadeHook', which is
+--   similar to but not identical to 'ManageHook'.
+fadeWindowsLogHook   :: FadeHook -> X ()
+fadeWindowsLogHook h =  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 $ \w -> do
+    o <- userCodeDef (Opacity 1) (runQuery h w)
+    setOpacity w $ case o of
+                     OEmpty    -> 0.93
+                     Opacity r -> r
+
+-- | A 'handleEventHook' to handle fading and unfading of newly mapped
+--   or unmapped windows; this avoids problems with layouts such as
+--   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may
+--   also be useful with "XMonad.Hooks.FadeInactive".
+fadeWindowsEventHook                     :: Event -> X All
+fadeWindowsEventHook (MapNotifyEvent {}) =
+  -- we need to run the fadeWindowsLogHook.  only one way...
+  asks config >>= logHook >> return (All True)
+fadeWindowsEventHook _                   =  return (All True)
+
+-- A utility to clamp opacity fractions to the range (0,1)
+clampRatio   :: Rational         -> Rational
+clampRatio r |  r >= 0 && r <= 1 =  r
+             |  r < 0            =  0
+             |  otherwise        =  1

XMonad/Hooks/FloatNext.hs

@@ -0,0 +1,120 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.FloatNext
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- 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 XMonad
+import XMonad.Hooks.ToggleHook
+
+hookName :: String
+hookName = "__float"
+
+-- $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 = toggleHook hookName doFloat
+
+-- | @floatNext True@ arranges for the next spawned window to be
+-- sent to the floating layer, @floatNext False@ cancels it.
+floatNext :: Bool -> X ()
+floatNext = hookNext hookName
+
+toggleFloatNext :: X ()
+toggleFloatNext = toggleHookNext hookName
+
+-- | @floatAllNew True@ arranges for new windows to be
+-- sent to the floating layer, @floatAllNew False@ cancels it
+floatAllNew :: Bool -> X ()
+floatAllNew = hookAllNew hookName
+
+toggleFloatAllNew :: X ()
+toggleFloatAllNew = toggleHookAllNew hookName
+
+-- | Whether the next window will be set floating
+willFloatNext :: X Bool
+willFloatNext = willHookNext hookName
+
+-- | Whether new windows will be set floating
+willFloatAllNew :: X Bool
+willFloatAllNew = willHookAllNew hookName
+
+-- $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 = willHookNextPP hookName
+
+willFloatAllNewPP :: (String -> String) -> X (Maybe String)
+willFloatAllNewPP = willHookAllNewPP hookName

XMonad/Hooks/ICCCMFocus.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ICCCMFocus
+-- License      : BSD
+--
+-- Maintainer   : Tony Morris <haskell@tmorris.net>
+--
+-- Implemented in your @logHook@, Java swing applications will not misbehave
+-- when it comes to taking and losing focus.
+--
+-- This has been done by taking the patch in <http://code.google.com/p/xmonad/issues/detail?id=177> and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@.
+--
+-- @
+--    conf' =
+--      conf {
+--        logHook = takeTopFocus
+--      }
+-- @
+-----------------------------------------------------------------------------
+module XMonad.Hooks.ICCCMFocus
+(
+  atom_WM_TAKE_FOCUS  
+, takeFocusX
+, takeTopFocus
+) where
+
+import XMonad
+import XMonad.Hooks.SetWMName
+import qualified XMonad.StackSet as W
+import Control.Monad
+
+atom_WM_TAKE_FOCUS ::
+  X Atom
+atom_WM_TAKE_FOCUS =
+  getAtom "WM_TAKE_FOCUS"
+
+takeFocusX ::
+  Window
+  -> X ()
+takeFocusX w =
+  withWindowSet . const $ do
+    dpy       <- asks display
+    wmtakef   <- atom_WM_TAKE_FOCUS
+    wmprot    <- atom_WM_PROTOCOLS
+    protocols <- io $ getWMProtocols dpy w
+    when (wmtakef `elem` protocols) $
+      io . allocaXEvent $ \ev -> do
+          setEventType ev clientMessage
+          setClientMessageEvent ev w wmprot 32 wmtakef currentTime
+          sendEvent dpy w False noEventMask ev
+
+-- | The value to add to your log hook configuration.
+takeTopFocus ::
+  X ()
+takeTopFocus =
+  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"  
+

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,5 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS -fglasgow-exts #-}
--- deriving Typeable
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
+-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.ManageDocks
@@ -17,37 +16,76 @@
 module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
-    manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts)
+    manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docksEventHook,
+    ToggleStruts(..),
+    SetStruts(..),
+    module XMonad.Util.Types,
+
+#ifdef TESTING
+    r2c,
+    c2r,
+    RectC(..),
+#endif
+
+    -- for XMonad.Actions.FloatSnap
+    calcGap
     ) where
 
 
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
-import Control.Monad
 import XMonad.Layout.LayoutModifier
+import XMonad.Util.Types
+import XMonad.Util.WindowProperties (getProp32s)
+import XMonad.Util.XUtils (fi)
+import Data.Monoid (All(..))
+
+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:
+-- The third component is an event hook that causes new docks to appear
+-- immediately, instead of waiting for the next focus change.
 --
--- > ,((modMask x, xK_b     ), sendMessage ToggleStruts)
+-- > handleEventHook = ... <+> docksEventHook
+--
+-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
+-- similar to:
+--
+-- > ,((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
@@ -58,58 +96,56 @@ import XMonad.Layout.LayoutModifier
 --
 -- 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 or DESKTOP 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"
     dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
     desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
-    mbr <- getProp a w
+    mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
     case mbr of
         Just [r] -> return $ elem (fromIntegral r) [dock, desk]
         _        -> return False
 
--- |
--- Gets the STRUT config, if present, in xmonad gap order
+-- | Whenever a new dock appears, refresh the layout immediately to avoid the
+-- new dock.
+docksEventHook :: Event -> X All
+docksEventHook (MapNotifyEvent {ev_window = w}) = do
+    whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh
+    return (All True)
+docksEventHook _ = return (All True)
+
+-- | Gets the STRUT config, if present, in xmonad gap order
 getStrut :: Window -> X [Strut]
 getStrut w = do
-    spa <- getAtom "_NET_WM_STRUT_PARTIAL"
-    sa  <- getAtom "_NET_WM_STRUT"
-    msp <- getProp spa w
+    msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
     case msp of
         Just sp -> return $ parseStrutPartial sp
-        Nothing -> fmap (maybe [] parseStrut) $ getProp sa w
+        Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w
  where
     parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
     parseStrut _ = []
 
     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), (T, t, tx1, tx2), (B, b, bx1, bx2)]
+        [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)]
     parseStrutPartial _ = []
 
--- |
--- Helper to read a property
-getProp :: Atom -> Window -> X (Maybe [CLong])
-getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
-
--- |
--- Goes through the list of windows and find the gap so that all STRUT
--- settings are satisfied.
-calcGap :: X (Rectangle -> 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 <- concat `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
@@ -117,69 +153,111 @@ calcGap = withDisplay $ \dpy -> do
     wa <- io $ getWindowAttributes dpy rootw
     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
 
--- | Adjust layout automagically.
+-- | Adjust layout automagically: don't cover up any docks, status
+--   bars, etc.
 avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
-avoidStruts = ModifiedLayout (AvoidStruts True)
+avoidStruts = avoidStrutsOn [U,D,L,R]
 
-data AvoidStruts a = AvoidStruts Bool deriving ( Read, Show )
+-- | 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)
 
-data ToggleStruts = ToggleStruts 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 b) w r = do
-        nr <- if b then fmap ($ r) calcGap else return r
+    modifyLayout (AvoidStruts ss) w r = do
+        nr <- fmap ($ r) (calcGap ss)
         runLayout w nr
 
-    handleMess (AvoidStruts b ) m
-        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b)
-        | otherwise = return Nothing
+    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
 
-data Side = L | R | T | B
 
--- | (Side, height\/width, initial pixel, final pixel).
+-- | (Direction, height\/width, initial pixel, final pixel).
 
-type Strut = (Side, CLong, CLong, CLong)
+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
+newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show)
 
 -- | Invertible conversion.
 
 r2c :: Rectangle -> RectC
-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
+r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
 
 -- | Invertible conversion.
 
 c2r :: RectC -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
+c2r (RectC (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       )
-    T | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )
-    B | p (x0, x1) -> (x0           , y0       , x1       , mn y1 sy1)
-    _              -> (x0           , y0       , x1       , y1       )
+reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) =
+ RectC $ case s of
+    L | p (y0, y1) && qh x1     -> (mx x0 sx0, y0       , x1       , y1       )
+    R | p (y0, y1) && qv sx1 x0 -> (x0       , y0       , mn x1 sx1, y1       )
+    U | p (x0, x1) && qh y1     -> (x0       , mx y0 sy0, x1       , y1       )
+    D | p (x0, x1) && qv sy1 y0 -> (x0       , y0       , x1       , mn y1 sy1)
+    _                           -> (x0       , y0       , x1       , y1       )
  where
     mx a b = max a (b + n)
     mn a b = min a (b - n)
     p r = r `overlaps` (l, h)
+    -- Filter out struts that cover the entire rectangle:
+    qh d1 = n <= d1
+    qv sd1 d0 = sd1 - n >= d0
 
 -- | Do the two ranges overlap?
 --

XMonad/Hooks/ManageHelpers.hs

@@ -8,8 +8,8 @@
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- This module provides helper functions to be used in @manageHook@. Here's how you
--- might use this:
+-- This module provides helper functions to be used in @manageHook@. Here's
+-- how you might use this:
 --
 -- > import XMonad.Hooks.ManageHelpers
 -- > main =
@@ -18,30 +18,51 @@
 -- >         manageHook = composeOne [
 -- >             isKDETrayWindow -?> doIgnore,
 -- >             transience,
+-- >             isFullscreen -?> doFullFloat,
 -- >             resource =? "stalonetray" -?> doIgnore
 -- >         ],
 -- >         ...
 -- >     }
 
 module XMonad.Hooks.ManageHelpers (
+    Side(..),
     composeOne,
     (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
+    currentWs,
+    isInProperty,
     isKDETrayWindow,
+    isFullscreen,
+    isDialog,
+    pid,
     transientTo,
     maybeToDefinite,
     MaybeManageHook,
     transience,
     transience',
     doRectFloat,
-    doCenterFloat
+    doFullFloat,
+    doCenterFloat,
+    doSideFloat,
+    doFloatAt,
+    doFloatDep,
+    doHideIgnore,
+    Match,
 ) 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 Northeast
+-- 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.
@@ -99,16 +120,43 @@ p -?>> f = do
     Match b m <- p
     if b then fmap  Just (f m) else return Nothing
 
+-- | Return the current workspace
+currentWs :: Query WorkspaceId
+currentWs = liftX (withWindowSet $ return . W.currentTag)
+
 -- | A predicate to check whether a window is a KDE system tray icon.
 isKDETrayWindow :: Query Bool
 isKDETrayWindow = ask >>= \w -> liftX $ do
-    dpy <- asks display
-    kde_tray <- getAtom "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR"
-    r <- io $ getWindowProperty32 dpy kde_tray w
+    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'.
@@ -140,9 +188,41 @@ doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1
             -> 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 = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w)
-    where
-    center (W.RationalRect _ _ w h) = W.RationalRect ((1-w)/2) ((1-h)/2) w h
+doCenterFloat = doSideFloat C
+
+-- | Hides window and ignores it.
+doHideIgnore :: ManageHook
+doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)

XMonad/Hooks/Minimize.hs

@@ -0,0 +1,53 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.Minimize
+-- Copyright   :  (c) Justin Bogner 2010
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Handles window manager hints to minimize and restore windows. Use
+-- this with XMonad.Layout.Minimize.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.Minimize
+    ( -- * Usage
+      -- $usage
+      minimizeEventHook
+    ) 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.Minimize
+-- > import XMonad.Layout.Minimize
+-- >
+-- > myHandleEventHook = minimizeEventHook
+-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout
+-- >                             , handleEventHook = myHandleEventHook }
+
+minimizeEventHook :: Event -> X All
+minimizeEventHook (ClientMessageEvent {ev_window = w,
+                                       ev_message_type = mt,
+                                       ev_data = dt}) = do
+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+    a_cs <- getAtom "WM_CHANGE_STATE"
+
+    when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)
+    when (mt == a_cs) $ do
+      let message = fromIntegral . head $ dt
+      when (message == normalState) $ sendMessage (RestoreMinimizedWin w)
+      when (message == iconicState) $ minimizeWindow w
+
+    return (All True)
+minimizeEventHook _ = return (All True)

XMonad/Hooks/Place.hs

@@ -0,0 +1,459 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.Place
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- 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 XMonad.Util.XUtils
+
+import qualified Data.Map as M
+import Data.Ratio ((%))
+import Data.List (sortBy, minimumBy, partition)
+import Data.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
+
+
+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/PositionStoreHooks.hs

@@ -0,0 +1,106 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.PositionStoreHooks
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This module contains two hooks for the
+-- PositionStore (see "XMonad.Util.PositionStore") - a ManageHook and
+-- an EventHook.
+--
+-- The ManageHook can be used to fill the PositionStore with position and size
+-- information about new windows. The advantage of using this hook is, that the
+-- information is recorded independent of the currently active layout. So the
+-- floating shape of the window can later be restored even if it was opened in a
+-- tiled layout initially.
+--
+-- For windows, that do not request a particular position, a random position will
+-- be assigned. This prevents windows from piling up exactly on top of each other.
+--
+-- The EventHook makes sure that windows are deleted from the PositionStore
+-- when they are closed.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.PositionStoreHooks (
+    -- * Usage
+    -- $usage
+    positionStoreManageHook,
+    positionStoreEventHook
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.PositionStore
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.Decoration
+
+import System.Random(randomRIO)
+import Control.Applicative((<$>))
+import Control.Monad(when)
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Set as S
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.PositionStoreHooks
+--
+-- and adding 'positionStoreManageHook' to your 'ManageHook' as well
+-- as 'positionStoreEventHook' to your event hooks. To be accurate
+-- about window sizes, the module needs to know if any decoration is in effect.
+-- This is specified with the first argument: Supply 'Nothing' for no decoration,
+-- otherwise use 'Just defaultTheme' or similar to inform the module about the
+-- decoration theme used.
+--
+-- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig
+-- > myHandleEventHook = positionStoreEventHook
+-- >
+-- > main = xmonad defaultConfig { manageHook = myManageHook
+-- >                             , handleEventHook = myHandleEventHook
+-- >                             }
+--
+
+positionStoreManageHook :: Maybe Theme -> ManageHook
+positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
+
+positionStoreInit :: Maybe Theme -> Window -> X ()
+positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
+        let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current
+                                                    -- form - makes windows smaller to make room for it
+        wa <- io $ getWindowAttributes d w
+        ws <- gets windowset
+        arbitraryOffsetX <- randomIntOffset
+        arbitraryOffsetY <- randomIntOffset
+        if (wa_x wa == 0) && (wa_y wa == 0)
+            then do
+                let sr@(Rectangle srX srY _ _) = screenRect . W.screenDetail . W.current $ ws
+                modifyPosStore (\ps -> posStoreInsert ps w
+                                        (Rectangle (srX + fi arbitraryOffsetX)
+                                                   (srY + fi arbitraryOffsetY)
+                                                    (fi $ wa_width wa)
+                                                    (decoH + fi (wa_height wa))) sr )
+            else do
+                sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
+                let sr = screenRect . W.screenDetail $ sc
+                sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound])    -- take docks into account, accepting
+                                                                                    -- a somewhat unfortunate inter-dependency
+                                                                                    -- with 'XMonad.Hooks.ManageDocks'
+                modifyPosStore (\ps -> posStoreInsert ps w
+                                        (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
+                                            (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
+    where
+        randomIntOffset :: X (Int)
+        randomIntOffset = io $ randomRIO (42, 242)
+
+positionStoreEventHook :: Event -> X All
+positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
+    when (et == destroyNotify) $ do
+        modifyPosStore (\ps -> posStoreRemove ps w)
+    return (All True)
+positionStoreEventHook _ = return (All True)

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
+--
+-- (Deprecated: Use XMonad.Hooks.Minimize) 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/ScreenCorners.hs

@@ -0,0 +1,170 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ScreenCorners
+-- Copyright   :  (c) 2009 Nils Schweinsberg
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Run @X ()@ actions by touching the edge of your screen with your mouse.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ScreenCorners
+    (
+    -- * Usage
+    -- $usage
+
+    -- * Adding screen corners
+      ScreenCorner (..)
+    , addScreenCorner
+    , addScreenCorners
+
+    -- * Event hook
+    , screenCornerEventHook
+    ) where
+
+import Data.Monoid
+import Data.List (find)
+import XMonad
+import XMonad.Util.XUtils (fi)
+
+import qualified Data.Map as M
+import qualified XMonad.Util.ExtensibleState as XS
+
+data ScreenCorner = SCUpperLeft
+                  | SCUpperRight
+                  | SCLowerLeft
+                  | SCLowerRight
+                  deriving (Eq, Ord, Show)
+
+
+
+--------------------------------------------------------------------------------
+-- ExtensibleState modifications
+--------------------------------------------------------------------------------
+
+newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
+    deriving Typeable
+
+instance ExtensionClass ScreenCornerState where
+    initialValue = ScreenCornerState M.empty
+
+-- | Add one single @X ()@ action to a screen corner
+addScreenCorner :: ScreenCorner -> X () -> X ()
+addScreenCorner corner xF = do
+
+    ScreenCornerState m <- XS.get
+    (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
+
+                        Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
+                        Nothing           -> flip (,) xF `fmap` createWindowAt corner
+
+    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
+
+-- | Add a list of @(ScreenCorner, X ())@ tuples
+addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
+addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
+
+
+--------------------------------------------------------------------------------
+-- Xlib functions
+--------------------------------------------------------------------------------
+
+-- "Translate" a ScreenCorner to real (x,y) Positions
+createWindowAt :: ScreenCorner -> X Window
+createWindowAt SCUpperLeft = createWindowAt' 0 0
+createWindowAt SCUpperRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) 0
+
+createWindowAt SCLowerLeft = withDisplay $ \dpy ->
+    let h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' 0 (fi h)
+
+createWindowAt SCLowerRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+        h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) (fi h)
+
+-- Create a new X window at a (x,y) Position
+createWindowAt' :: Position -> Position -> X Window
+createWindowAt' x y = withDisplay $ \dpy -> io $ do
+
+    rootw <- rootWindow dpy (defaultScreen dpy)
+
+    let
+        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
+        attrmask = cWOverrideRedirect
+
+    w <- allocaSetWindowAttributes $ \attributes -> do
+
+        set_override_redirect attributes True
+        createWindow dpy        -- display
+                     rootw      -- parent window
+                     x          -- x
+                     y          -- y
+                     1          -- width
+                     1          -- height
+                     0          -- border width
+                     0          -- depth
+                     inputOnly  -- class
+                     visual     -- visual
+                     attrmask   -- valuemask
+                     attributes -- attributes
+
+    -- we only need mouse entry events
+    selectInput dpy w enterWindowMask
+    mapWindow dpy w
+    sync dpy False
+    return w
+
+
+--------------------------------------------------------------------------------
+-- Event hook
+--------------------------------------------------------------------------------
+
+-- | Handle screen corner events
+screenCornerEventHook :: Event -> X All
+screenCornerEventHook CrossingEvent { ev_window = win } = do
+
+    ScreenCornerState m <- XS.get
+
+    case M.lookup win m of
+         Just (_, xF) -> xF
+         Nothing      -> return ()
+
+    return (All True)
+
+screenCornerEventHook _ = return (All True)
+
+
+--------------------------------------------------------------------------------
+-- $usage
+--
+-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
+-- into one of your screen corners you can trigger an @X ()@ action, for
+-- example @"XMonad.Actions.GridSelect".goToSelected@ or
+-- @"XMonad.Actions.CycleWS".nextWS@ etc.
+--
+-- To use it, import it on top of your @xmonad.hs@:
+--
+-- > import XMonad.Hooks.ScreenCorners
+--
+-- Then add your screen corners in our startup hook:
+--
+-- > myStartupHook = do
+-- >     ...
+-- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
+-- >     addScreenCorners [ (SCLowerRight, nextWS)
+-- >                      , (SCLowerLeft,  prevWS)
+-- >                      ]
+--
+-- And finally wait for screen corner events in your event hook:
+--
+-- > myEventHook e = do
+-- >     ...
+-- >     screenCornerEventHook e

XMonad/Hooks/Script.hs

@@ -0,0 +1,53 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 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

@@ -59,45 +59,47 @@ module XMonad.Hooks.ServerMode
     ( -- * Usage
       -- $usage
       ServerMode (..)
-    , eventHook
+    , serverModeEventHook
+    , serverModeEventHook'
     ) where
 
 import Control.Monad (when)
-import Data.List
+import Data.Monoid
 import System.IO
 
 import XMonad
 import XMonad.Actions.Commands
-import XMonad.Hooks.EventHook
 
 -- $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 @layoutHook@ by adding the 'eventHook':
+-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
 --
--- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc..
+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
 --
--- and then:
---
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
---
--- For more detailed instructions on editing the layoutHook see:
---
--- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 data ServerMode = ServerMode deriving ( Show, Read )
 
-instance EventHook ServerMode where
-    handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+-- | 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 <- defaultCommands
+             cl <- cmdAction
              let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
              case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
-                  Just (c,_) -> runCommand' c
-                  Nothing    -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
-    handleEvent _ _ = return ()
+                  Just (_,action) -> action
+                  Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+        return (All True)
+serverModeEventHook' _ _ = return (All True)

XMonad/Hooks/SetWMName.hs

@@ -14,13 +14,13 @@
 -- 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
@@ -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/ToggleHook.hs

@@ -0,0 +1,169 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ToggleHook
+-- Copyright   :  Ben Boeckel <mathstuf@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Ben Boeckel <mathstuf@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Hook and keybindings for toggling hook behavior.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ToggleHook ( -- * Usage
+                                 -- $usage
+
+                                 -- * The hook
+                                 toggleHook
+                               , toggleHook'
+
+                                 -- * Actions
+                               , hookNext
+                               , toggleHookNext
+                               , hookAllNew
+                               , toggleHookAllNew
+
+                                 -- * Queries
+                               , willHook
+                               , willHookNext
+                               , willHookAllNew
+
+                                 -- * 'DynamicLog' utilities
+                                 -- $pp
+                               , willHookNextPP
+                               , willHookAllNewPP
+                               , runLogHook ) where
+
+import Prelude hiding (all)
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+
+import Control.Monad (join,guard)
+import Control.Applicative ((<$>))
+import Control.Arrow (first, second)
+
+import Data.Map
+
+{- Helper functions -}
+
+_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
+_set n f b = modify' n (f $ const b)
+
+_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
+_toggle n f = modify' n (f not)
+
+_get :: String -> ((Bool, Bool) -> a) -> X a
+_get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks)
+
+_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
+_pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
+
+{- The current state is kept here -}
+
+data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable)
+
+instance ExtensionClass HookState where
+    initialValue = HookState empty
+
+modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
+modify' n f = XS.modify (HookState . setter . hooks)
+    where
+        setter m = insert n (f (findWithDefault (False, False) n m)) m
+
+-- $usage
+-- This module provides actions (that can be set as keybindings)
+-- to be able to cause hooks to be occur on a conditional basis.
+--
+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.ToggleHook
+--
+-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
+-- name of the hook and @hook@ is the hook to execute based on the state.
+--
+-- > myManageHook = toggleHook "float" doFloat <+> manageHook defaultConfig
+--
+-- Additionally, toggleHook' is provided to toggle between two hooks (rather
+-- than on/off).
+--
+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig
+--
+-- The 'hookNext' and 'toggleHookNext' functions can be used in key
+-- bindings to set whether the hook is applied or not.
+--
+-- > , ((modm, xK_e), toggleHookNext "float")
+--
+-- 'hookAllNew' and 'toggleHookAllNew' are similar but float all
+-- spawned windows until disabled again.
+--
+-- > , ((modm, xK_r), toggleHookAllNew "float")
+
+-- | This 'ManageHook' will selectively apply a hook as set
+-- by 'hookNext' and 'hookAllNew'.
+toggleHook :: String -> ManageHook -> ManageHook
+toggleHook n h = toggleHook' n h idHook
+
+toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
+toggleHook' n th fh = do m <- liftX $ XS.gets hooks
+                         (next, all) <- return $ findWithDefault (False, False) n m
+                         liftX $ XS.put $ HookState $ insert n (False, all) m
+                         if next || all then th else fh
+
+-- | @hookNext name True@ arranges for the next spawned window to
+-- have the hook @name@ applied, @hookNext name False@ cancels it.
+hookNext :: String -> Bool -> X ()
+hookNext n = _set n first
+
+toggleHookNext :: String -> X ()
+toggleHookNext n = _toggle n first
+
+-- | @hookAllNew name True@ arranges for new windows to
+-- have the hook @name@ applied, @hookAllNew name False@ cancels it
+hookAllNew :: String -> Bool -> X ()
+hookAllNew n = _set n second
+
+toggleHookAllNew :: String -> X ()
+toggleHookAllNew n = _toggle n second
+
+-- | Query what will happen at the next ManageHook call for the hook @name@.
+willHook :: String -> X Bool
+willHook n = willHookNext n <||> willHookAllNew n
+
+-- | Whether the next window will trigger the hook @name@.
+willHookNext :: String -> X Bool
+willHookNext n = _get n fst
+
+-- | Whether new windows will trigger the hook @name@.
+willHookAllNew :: String -> X Bool
+willHookAllNew n = _get n snd
+
+-- $pp
+-- The following functions are used to display the current
+-- state of 'hookNext' and 'hookAllNew' in your
+-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.
+-- 'willHookNextPP' and 'willHookAllNewPP' 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 'hookNext'/... will be visible
+-- immediately:
+--
+-- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook)
+--
+-- The @String -> String@ parameters to 'willHookNextPP' and
+-- 'willHookAllNewPP' will be applied to their output, you
+-- can use them to set the text color, etc., or you can just
+-- pass them 'id'.
+
+willHookNextPP :: String -> (String -> String) -> X (Maybe String)
+willHookNextPP n = _pp n fst "Next"
+
+willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
+willHookAllNewPP n = _pp n snd "All"
+
+runLogHook :: X ()
+runLogHook = join $ asks $ logHook . config

XMonad/Hooks/UrgencyHook.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,
+  FlexibleInstances #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -19,40 +20,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(..),
+                                 StdoutUrgencyHook(..),
+                                 SpawnUrgencyHook(..),
                                  UrgencyHook(urgencyHook),
-                                 seconds
+                                 Interval,
                                  ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import XMonad.Layout.LayoutModifier hiding (hook)
 import XMonad.Util.Dzen (dzenWithArgs, seconds)
+import qualified XMonad.Util.ExtensibleState as XS
 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.IORef
-import Data.List ((\\), delete)
-import Data.Maybe (listToMaybe)
+import Data.Bits (testBit)
+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,128 +103,342 @@ 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 'withUrgencyHookC'
+-- 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
+    }
+
+data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
+
+onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents
+onUrgents f = Urgents . f . fromUrgents
+
+instance ExtensionClass Urgents where
+    initialValue = Urgents []
+    extensionType = PersistentExtension
+
+-- | 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
 
--- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
--- 'readUrgents' or 'withUrgents' instead.
-{-# NOINLINE urgents #-}
-urgents :: IORef [Window]
-urgents = unsafePerformIO (newIORef [])
--- (Hey, I don't like it any more than you do.)
+-- | Just makes the urgents go away.
+-- Example keybinding:
+--
+-- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
+clearUrgents :: X ()
+clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
 
 -- | X action that returns a list of currently urgent windows. You might use
 -- it, or 'withUrgents', in your custom logHook, to display the workspaces that
 -- contain urgent windows.
 readUrgents :: X [Window]
-readUrgents = io $ readIORef urgents
+readUrgents = XS.gets fromUrgents
 
 -- | An HOF version of 'readUrgents', for those who prefer that sort of thing.
 withUrgents :: ([Window] -> X a) -> X a
 withUrgents f = readUrgents >>= f
 
-data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)
+adjustUrgents :: ([Window] -> [Window]) -> X ()
+adjustUrgents = XS.modify . onUrgents
+
+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 (Show,Read,Eq,Typeable)
+
+instance ExtensionClass [Reminder] where
+    initialValue = []
+    extensionType = PersistentExtension
+
+-- | Stores the list of urgency reminders.
+
+readReminders :: X [Reminder]
+readReminders = XS.get
+
+adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
+adjustReminders = XS.modify
+
+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)
+      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 = do
+    sw' <- suppressibleWindows sw
+    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
+
+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

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.XPropManage
@@ -17,14 +18,14 @@ module XMonad.Hooks.XPropManage (
                  xPropManageHook, XPropMatch, pmX, pmP
                  ) where
 
+import Prelude hiding (catch)
+import Control.Exception
 import Data.Char (chr)
-import Data.List (concat)
 import Data.Monoid (mconcat, Endo(..))
 
 import Control.Monad.Trans (lift)
 
 import XMonad
-import XMonad.ManageHook ((-->))
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -34,7 +35,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,11 +72,11 @@ 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
-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
+    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
     let filt q | q == wM_COMMAND = concat . map splitAtNull
                | otherwise       = id
     return (filt p prop)

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:
 --
@@ -42,7 +42,7 @@ data Accordion a = Accordion deriving ( Read, Show )
 instance LayoutClass Accordion Window where
     pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
      where
-       ups    = W.up ws
+       ups    = reverse $ W.up ws
        dns    = W.down ws
        (top,  allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc
        (center,  bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop

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, 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 (Eq w) => LayoutModifier AutoMaster w 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 :: (Eq w, LayoutClass l w) =>
+              Int ->
+              Float ->
+              W.Workspace WorkspaceId (l w) w
+              -> Rectangle
+              -> X ([(w, Rectangle)], Maybe (l w))
+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,225 @@
+{-# 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,
+-- but it is probably must useful in a floating layout such as
+-- "XMonad.Layout.PositionStoreFloat" with which it has been mainly tested.
+-- See the documentation of PositionStoreFloat for a typical usage example.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BorderResize
+    ( -- * Usage
+      -- $usage
+      borderResize
+    , BorderResize (..)
+    , RectWithBorders, BorderInfo,
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.WindowArranger
+import XMonad.Util.XUtils
+import Control.Monad(when)
+import qualified Data.Map as M
+
+-- $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 }
+--
+
+type BorderBlueprint = (Rectangle, Glyph, BorderType)
+
+data BorderType = RightSideBorder
+                    | LeftSideBorder
+                    | TopSideBorder
+                    | BottomSideBorder
+                    deriving (Show, Read, Eq)
+data BorderInfo = BI { bWin :: Window,
+                        bRect :: Rectangle,
+                        bType :: BorderType
+                     } deriving (Show, Read)
+
+type RectWithBorders = (Rectangle, [BorderInfo])
+
+data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
+
+brBorderOffset :: Position
+brBorderOffset = 5
+brBorderSize :: Dimension
+brBorderSize = 10
+
+borderResize :: l a -> ModifiedLayout BorderResize l a
+borderResize = ModifiedLayout (BR M.empty)
+
+instance LayoutModifier BorderResize Window where
+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
+    redoLayout (BR wrsLastTime) _ _ wrs = do
+            let correctOrder = map fst wrs
+                wrsCurrent = M.fromList wrs
+                wrsGone = M.difference wrsLastTime wrsCurrent
+                wrsAppeared = M.difference wrsCurrent wrsLastTime
+                wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent
+            handleGone wrsGone
+            wrsCreated <- handleAppeared wrsAppeared
+            let wrsChanged = handleStillThere wrsStillThere
+                wrsThisTime = M.union wrsChanged wrsCreated
+            return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime)
+            -- 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.
+        where
+            testIfUnchanged entry@(rLastTime, _) rCurrent =
+                if rLastTime == rCurrent
+                    then (Nothing, entry)
+                    else (Just rCurrent, entry)
+
+    handleMess (BR wrsLastTime) m
+        | Just e <- fromMessage m :: Maybe Event =
+            handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing
+        | Just _ <- fromMessage m :: Maybe LayoutMessages =
+            handleGone wrsLastTime >> return (Just $ BR M.empty)
+    handleMess _ _ = return Nothing
+
+compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
+compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder
+                                      in concat $ map compileWr wrs
+
+compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]
+compileWr (w, (r, borderInfos)) =
+    let borderWrs = for borderInfos $ \bi -> (bWin bi, bRect bi)
+    in borderWrs ++ [(w, r)]
+
+handleGone :: M.Map Window RectWithBorders -> X ()
+handleGone wrsGone = mapM_ deleteWindow borderWins
+    where
+        borderWins = map bWin . concat . map snd . M.elems $ wrsGone
+
+handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)
+handleAppeared wrsAppeared = do
+    let wrs = M.toList wrsAppeared
+    wrsCreated <- mapM handleSingleAppeared wrs
+    return $ M.fromList wrsCreated
+
+handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders)
+handleSingleAppeared (w, r) = do
+    let borderBlueprints = prepareBorders r
+    borderInfos <- mapM createBorder borderBlueprints
+    return (w, (r, borderInfos))
+
+handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders
+handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere
+
+handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders
+handleSingleStillThere (Nothing, entry) = entry
+handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)
+    where
+        changedBorderBlueprints = prepareBorders rCurrent
+        updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints
+          -- assuming that the four borders are always in the same order
+
+updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo
+updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r }
+
+createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]
+createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime
+    where
+        processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]
+        processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r))
+
+prepareBorders :: Rectangle -> [BorderBlueprint]
+prepareBorders (Rectangle x y wh ht) =
+    [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder),
+     ((Rectangle (x - brBorderOffset) y brBorderSize ht)        , xC_left_side  , LeftSideBorder),
+     ((Rectangle x (y - brBorderOffset) wh brBorderSize)        , xC_top_side   , TopSideBorder),
+     ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder)
+    ]
+
+handleResize :: [(Window, (BorderType, Window, Rectangle))] -> 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 :: BorderBlueprint -> X (BorderInfo)
+createBorder (borderRect, borderCursor, borderType) = do
+    borderWin <- createInputWindow borderCursor borderRect
+    return BI { bWin = borderWin, bRect = borderRect, bType = borderType }
+
+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
+
+reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
+reorder wrs order =
+    let ordered = concat $ map (pickElem wrs) order
+        rest = filter (\(w, _) -> not (w `elem` order)) wrs
+    in ordered ++ rest
+    where
+        pickElem list e = case (lookup e list) of
+                                Just result -> [(e, result)]
+                                Nothing -> []

XMonad/Layout/BoringWindows.hs

@@ -0,0 +1,149 @@
+{-# 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  :  Adam Vogt <vogt.adam@gmail.com>
+-- 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()
+
+                                   -- * Tips
+                                   -- ** variant of 'Full'
+                                   -- $simplest
+                                  ) where
+
+import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
+                                    LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
+import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
+              sendMessage, windows, withFocused, Window)
+import Control.Applicative((<$>))
+import Data.List((\\), union)
+import Data.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
+
+{- $simplest
+
+An alternative to 'Full' is "XMonad.Layout.Simplest".  Less windows are
+ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows
+to be uninteresting by some other layout modifier (ex.
+"XMonad.Layout.Minimize")
+
+-}

XMonad/Layout/ButtonDecoration.hs

@@ -0,0 +1,56 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ButtonDecoration
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A decoration that includes small buttons on both ends which invoke
+-- various actions when clicked on: Show a window menu (see
+-- "XMonad.Actions.WindowMenu"), minimize, maximize or close the window.
+--
+-- 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.Layout.ButtonDecoration
+    ( -- * Usage:
+      -- $usage
+      buttonDeco,
+      ButtonDecoration,
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.DecorationAddons
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.DecorationAddons
+-- > import XMonad.Layout.ButtonDecoration
+--
+-- Then edit your @layoutHook@ by adding the ButtonDecoration to
+-- your layout:
+--
+-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+
+buttonDeco :: (Eq a, Shrinker s) => s -> Theme
+           -> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a
+buttonDeco s c = decoration s c $ NFD True
+
+data ButtonDecoration a = NFD Bool deriving (Show, Read)
+
+instance Eq a => DecorationStyle ButtonDecoration a where
+    describeDeco _ = "ButtonDeco"
+    decorationCatchClicksHook _ mainw dFL dFR = titleBarButtonHandler mainw dFL dFR
+    decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()

XMonad/Layout/CenteredMaster.hs

@@ -0,0 +1,111 @@
+{-# 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,
+         CenteredMaster, 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))
+
+