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

XMonad/Actions/CopyWindow.hs

@@ -2,14 +2,14 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CopyWindow
--- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
 -- 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, copyToAll, copyWindow, killAllOtherCopies, 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, workspaces)
-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,7 +54,12 @@ 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
@@ -58,59 +69,97 @@ import XMonad.StackSet
 --
 -- Here is the example of keybindings which provide these actions:
 --
--- >  , ((modMask x, xK_v )", windows copyToAll) -- @@ Make focused window always visible
--- >  , ((modMask x .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back
+-- >  , ((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 :: (Eq s, Eq i, Eq a) => i -> StackSet i l a s sd -> StackSet i l a s sd
-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
 
--- | copyToAll. Copy the focused window to all of workspaces.
-copyToAll :: (Eq s, Eq i, Eq a) => StackSet i l a s sd -> StackSet i l a s sd
-copyToAll s = foldr copy s $ map tag (workspaces 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)
 
--- | copyWindow.  Copy a window to a new workspace
-copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> StackSet i l a s sd -> StackSet i l a s sd
+-- | 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 `tagMember` s
-                    then view (currentTag s) $ insertUp' w $ view n s
+    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 = 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
+          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 current workspace'
---
--- Consider calling this function after copyToAll
---
+-- | 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 (peek ss) $ \w -> windows $
-                                                   view (currentTag ss) .
+                        whenJust (W.peek ss) $ \w -> windows $
+                                                   W.view (W.currentTag ss) .
                                                    delFromAllButCurrent w
     where
       delFromAllButCurrent w ss = foldr ($) ss $
-                                  map (delWinFromWorkspace w . tag) $
-                                  hidden ss ++ map workspace (visible ss)
-      delWinFromWorkspace w wid ss = modify Nothing (filter (/= w)) $ view wid 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

@@ -30,7 +30,7 @@ import XMonad.StackSet
 --
 -- > import XMonad.Actions.CycleRecentWS
 -- >
--- >   , ((modMask x, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
+-- >   , ((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".

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,15 +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
+            | 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
@@ -186,20 +246,28 @@ wsTypeToPred NonEmptyWS = return (isJust . stack)
 wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)
                              return (\w -> tag w `elem` hs)
 wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS
-			            hi <- wsTypeToPred HiddenWS
+                                    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
@@ -214,7 +282,7 @@ 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
@@ -229,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'
@@ -257,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

@@ -5,12 +5,13 @@
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
--- Stability   :  unstable
+-- 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

@@ -8,15 +8,18 @@
 -- 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,
@@ -25,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
 
@@ -97,25 +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.
+-- | 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
@@ -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` applySizeHintsContents 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".

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.GridSelect
@@ -8,28 +9,77 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- GridSelect displays a 2D grid of windows to navigate with cursor
--- keys and to select with return.
+-- 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,
-    default_colorizer
+    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 XMonad
+import qualified Data.Map as M
+import XMonad hiding (liftX)
 import XMonad.Util.Font
 import XMonad.Prompt (mkUnmanagedWindow)
 import XMonad.StackSet as W
@@ -37,6 +87,8 @@ 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
 --
@@ -46,53 +98,182 @@ import Text.Printf
 --
 -- Then add a keybinding, e.g.
 --
--- >    , ((modMask x, xK_g), goToSelected defaultGSConfig)
+-- >    , ((modm, xK_g), goToSelected defaultGSConfig)
 --
--- Screenshot: <http://clemens.endorphin.org/gridselect.png>
+-- 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"])
 
-data GSConfig = GSConfig {
+-- $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 :: Window -> Bool -> X (String, String),
-      gs_font :: String
+      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 TwoDWindowMap = [(TwoDPosition,(String,Window))]
+type TwoDElementMap a = [(TwoDPosition,(String,a))]
 
-data TwoDState = TwoDState { td_curpos :: TwoDPosition,
-                             td_windowmap :: [(TwoDPosition,(String,Window))],
-                             td_gsconfig :: GSConfig,
-                             td_font :: XMonadFont,
-                             td_paneX :: Integer,
-                             td_paneY :: Integer,
-                             td_drawingWin :: Window
-                           }
+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
 
-type TwoD a = StateT TwoDState X a
+newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
+    deriving (Monad,Functor,MonadState (TwoDState a))
 
-diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
--- FIXME remove nub
-diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
-        in nub $ ul ++ (map (negate *** id) ul) ++
-           (map (negate *** negate) ul) ++
-           (map (id *** negate) ul)
+instance Applicative (TwoD a) where
+    (<*>) = ap
+    pure = return
 
-diamond :: (Enum a, Num a) => [(a, a)]
+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 :: (Enum t, Num t, Ord t) => t -> t -> [(t, t)]
-diamondRestrict x y = L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
-                      L.takeWhile (\(x',y') -> abs x' + abs y' <= x+y) $ diamond
+diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
+diamondRestrict x y originX originY =
+  L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
+  map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
+  take 1000 $ diamond
 
-tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)
-tupadd (a,b) (c,d) = (a+c,b+d)
-
-findInWindowMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
-findInWindowMap pos = find ((== pos) . fst)
+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 =
@@ -116,14 +297,26 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
   liftIO $ freeGC dpy gc
   liftIO $ freeGC dpy bordergc
 
-updateAllWindows :: TwoD ()
-updateAllWindows =
+updateAllElements :: TwoD a ()
+updateAllElements =
     do
-      TwoDState { td_windowmap = wins } <- get
-      updateWindows wins
+      s <- get
+      updateElements (td_elementmap s)
 
-updateWindows :: TwoDWindowMap -> TwoD ()
-updateWindows windowmap = do
+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,
@@ -134,8 +327,8 @@ updateWindows windowmap = do
         cellheight = gs_cellheight gsconfig
         paneX' = div (paneX-cellwidth) 2
         paneY' = div (paneY-cellheight) 2
-        updateWindow (pos@(x,y),(text, clientwindow)) = lift $ do
-            colors <- (gs_colorizer gsconfig) clientwindow (pos == curpos)
+        updateElement (pos@(x,y),(text, element)) = liftX $ do
+            colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
                        cellheight
@@ -144,49 +337,182 @@ updateWindows windowmap = do
                        (paneX'+x*cellwidth)
                        (paneY'+y*cellheight)
                        (gs_cellpadding gsconfig)
-    mapM updateWindow windowmap
-    return ()
+    mapM_ updateElement elementmap
 
-eventLoop :: TwoD (Maybe Window)
-eventLoop = do
-  (keysym,string,event) <- lift $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
-                             nextEvent d e
+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
-                             (ks,s) <- if ev_event_type ev == keyPress
-                                       then lookupString $ asKeyEvent e
-                                       else return (Nothing, "")
-                             return (ks,s,ev)
-  handle (fromMaybe xK_VoidSymbol keysym,string) event
+                             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
 
-handle :: (KeySym, String)
-       -> Event
-       -> StateT TwoDState X (Maybe Window)
-handle (ks,_) (KeyEvent {ev_event_type = t})
-    | t == keyPress && ks == xK_Escape = return Nothing
-    | t == keyPress && (ks == xK_Left || ks == xK_h)  = diffAndRefresh (-1,0)
-    | t == keyPress && (ks == xK_Right || ks == xK_l) = diffAndRefresh (1,0)
-    | t == keyPress && (ks == xK_Down || ks == xK_j) = diffAndRefresh (0,1)
-    | t == keyPress && (ks == xK_Up || ks == xK_k) = diffAndRefresh (0,-1)
-    | t == keyPress && ks == xK_Return = do
-       (TwoDState { td_curpos = pos, td_windowmap = winmap }) <- get
-       return $ fmap (snd . snd) $ findInWindowMap pos winmap
-  where diffAndRefresh diff = do
-          state <- get
-          let windowmap = td_windowmap state
-              oldPos = td_curpos state
-              newPos = oldPos `tupadd` diff
-              newSelectedWin = findInWindowMap newPos windowmap
-          when (isJust newSelectedWin) $ do
-                                put state { td_curpos =  newPos }
-                                updateWindows (catMaybes [(findInWindowMap oldPos windowmap), newSelectedWin])
-          eventLoop
+-- | 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)
 
-handle _ (ExposeEvent { }) = do
-  updateAllWindows
-  eventLoop
+-- 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
 
-handle _ _ = do
-  eventLoop
 
 -- FIXME probably move that into Utils?
 -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
@@ -206,52 +532,95 @@ hsv2rgb (h,s,v) =
          5 -> (v,p,q)
          _ -> error "The world is ending. x mod a >= a."
 
-default_colorizer :: Window -> Bool -> X (String, String)
-default_colorizer w active = do
-    classname <- runQuery className w
-    let seed x = toInteger (sum $ map ((*x).fromEnum) classname) :: Integer
+-- | 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)
-    if active
-      then return ("#faff69", "black")
-      else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Integer).(*256)) [r, g, b] ), "white")
-  where
-    twodigitHex :: Integer -> String
-    twodigitHex a = printf "%02x" a
+    in if active
+         then return ("#faff69", "black")
+         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
 
--- | 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 returned.
-gridselect :: GSConfig -> X (Maybe Window)
-gridselect gsconfig =
+-- | 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 <- liftIO $ rootWindow dpy (defaultScreen dpy)
+    rootw <- asks theRoot
     s <- gets $ screenRect . W.screenDetail . W.current . windowset
-    windowList <- windowMap
     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)
+    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;
-    selectedWindow <- if (status == grabSuccess) then
-                          do
-                            let restriction :: Integer -> (GSConfig -> Integer) -> Double
-                                restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2
+    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
-                                winmap = zipWith (,) (diamondRestrict restrictX restrictY) windowList
-                            selectedWindow <- evalStateT (do updateAllWindows; eventLoop)
-                                                   (TwoDState (0,0)
-                                                              winmap
-                                                              gsconfig
-                                                              font
-                                                              screenWidth
-                                                              screenHeight
-                                                              win)
-                            return selectedWindow
+                                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
@@ -259,19 +628,22 @@ gridselect gsconfig =
       destroyWindow dpy win
       sync dpy False
     releaseXMF font
-    return selectedWindow
+    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 -> X ()
+withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
 withSelectedWindow callback conf = do
-    mbWindow <- gridselect conf
+    mbWindow <- gridselectWindow conf
     case mbWindow of
         Just w -> callback w
         Nothing -> return ()
 
-
 windowMap :: X [(String,Window)]
 windowMap = do
     ws <- gets windowset
@@ -283,20 +655,44 @@ decorateName' :: Window -> X String
 decorateName' w = do
   fmap show $ getName w
 
-defaultGSConfig :: GSConfig
-defaultGSConfig = GSConfig 50 130 10 default_colorizer "xft:Sans-8"
+-- | 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 -> X ()
+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 -> X ()
+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.Hooks.ManageDocks (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:
 --
@@ -114,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
 --
@@ -42,9 +41,9 @@ chooseAction f = withWindowSet (f . S.currentTag)
 -- 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

@@ -78,9 +78,9 @@ data Limits
 -- 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 explicity.
+    | Lines Int -- ^ Specify the number of lines explicitly.
 
--- | This is the way most people would like to use this module.  It ataches the
+-- | 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'.

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

@@ -10,49 +10,66 @@
    Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
 
    Additional sites welcomed. -}
-module XMonad.Actions.Search (    -- * Usage
-                                  -- $usage
-                               search,
-                               SearchEngine(..),
-                               searchEngine,
-                               promptSearch,
-                               promptSearchBrowser,
-                               selectSearch,
-                               selectSearchBrowser,
-
-                               amazon,
-                               codesearch,
-                               deb,
-                               debbts,
-                               debpts,
-                               dictionary,
-                               google,
-                               hackage,
-                               hoogle,
-                               images,
-                               imdb,
-                               isohunt,
-                               maps,
-                               mathworld,
-                               scholar,
-                               thesaurus,
-                               wayback,
-                               wikipedia,
-                               youtube
+module XMonad.Actions.Search (   -- * Usage
+                                 -- $usage
+                                 search,
+                                 SearchEngine(..),
+                                 searchEngine,
+                                 searchEngineF,
+                                 promptSearch,
+                                 promptSearchBrowser,
+                                 selectSearch,
+                                 selectSearchBrowser,
+                                 isPrefixOf,
+                                 escape,
+                                 use,
+                                 intelligent,
+                                 (!>),
+                                 prefixAware,
+                                 namedEngine,
 
+                                 amazon,
+                                 alpha,
+                                 codesearch,
+                                 deb,
+                                 debbts,
+                                 debpts,
+                                 dictionary,
+                                 google,
+                                 hackage,
+                                 hoogle,
+                                 images,
+                                 imdb,
+                                 isohunt,
+                                 lucky,
+                                 maps,
+                                 mathworld,
+                                 openstreetmap,
+                                 scholar,
+                                 thesaurus,
+                                 wayback,
+                                 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 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), mkXPrompt, XPConfig(), historyCompletion)
+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
@@ -79,13 +96,15 @@ import XMonad.Util.XSelection (getSelection)
 
 * '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.
+* 'debpts'  -- Debian Package Tracking System.
 
 * 'dictionary' -- dictionary.reference.com search.
 
@@ -101,10 +120,14 @@ import XMonad.Util.XSelection (getSelection)
 
 * '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.
@@ -115,6 +138,8 @@ import XMonad.Util.XSelection (getSelection)
 
 * '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
@@ -153,7 +178,7 @@ Or in combination with XMonad.Util.EZConfig:
 >
 > ...
 >
-> searchList :: [([Char], S.SearchEngine)]
+> searchList :: [(String, S.SearchEngine)]
 > searchList = [ ("g", S.google)
 >              , ("h", S.hoohle)
 >              , ("w", S.wikipedia)
@@ -177,42 +202,36 @@ Happy searching! -}
 data Search = Search Name
 instance XPrompt Search where
     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 = concatMap . escapeURIChar
-           escapeURIChar :: (Char->Bool) -> Char -> String
-           escapeURIChar p c
-               | p c       = [c]
-               | otherwise = '%' : myShowHex (ord c) ""
-               where
-                 myShowHex :: Int -> ShowS
-                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of
-                                    []  -> "00"
-                                    [ch] -> ['0',ch]
-                                    cs  -> cs
-                 toChrHex d
-                   | d < 10    = chr (ord '0' + fromIntegral d)
-                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+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 Site         = 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
+-- | Given an already defined search engine, extracts its transformation
+--   function, making it easy to create compound search engines.
+--   For an instance you can use @use google@ to get a function which
+--   makes the same transformation as the google search engine would.
+use :: SearchEngine -> Site
+use (SearchEngine _ engine) = engine
+
+-- | Given a browser, a search engine's transformation function, and a search term, perform the
 --   requested search in the browser.
 search :: Browser -> Site -> Query -> X ()
-search browser site query = safeSpawn browser $ site ++ escape query
+search browser site query = safeSpawn browser [site query]
 
 {- | Given a base URL, create the 'SearchEngine' that escapes the query and
    appends it to the base. You can easily define a new engine locally using
@@ -222,45 +241,111 @@ search browser site query = safeSpawn browser $ site ++ escape query
 
    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.
+   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 -> Site -> SearchEngine
-searchEngine = SearchEngine
+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, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images,
-  imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia,
+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="
-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 "dictionary" "http://dictionary.reference.com/browse/"
-google     = searchEngine "google"     "http://www.google.com/search?num=100&q="
-hackage    = searchEngine "hackage" "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"
-hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="
-images     = searchEngine "images"     "http://images.google.fr/images?q="
-imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="
-isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="
-maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
-mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
-scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
-thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
-wikipedia  = searchEngine "wikipedia"  "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
-youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
-{- This doesn't seem to work, but nevertheless, it seems to be the official
-   method at <http://web.archive.org/collections/web/advanced.html> to get the
-   latest backup. -}
-wayback   = searchEngine "wayback" "http://web.archive.org/"
+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 historyCompletion $ search browser site
+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:

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.SpawnOn
@@ -8,29 +9,25 @@
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- This module provides helper functions to be used in @manageHook@. Here's
--- how you might use this:
+-- 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.
 --
--- > import XMonad.Hooks.ManageHelpers
--- > main = do
--- >     sp <- mkSpawner
--- >     xmonad defaultConfig {
--- >         ...
--- >         manageHook = spawnHook sp <+> manageHook defaultConfig
--- >         ...
--- >     }
+-----------------------------------------------------------------------------
 
 module XMonad.Actions.SpawnOn (
+    -- * Usage
+    -- $usage
     Spawner,
-    mkSpawner,
     manageSpawn,
     spawnHere,
     spawnOn,
+    spawnAndDo,
     shellPromptHere,
     shellPromptOn
 ) where
 
-import Data.IORef
+import Data.List (isInfixOf)
 import System.Posix.Types (ProcessID)
 
 import XMonad
@@ -39,39 +36,88 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prompt
 import XMonad.Prompt.Shell
+import qualified XMonad.Util.ExtensibleState as XS
 
-newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, WorkspaceId)]}
+-- $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
 
-mkSpawner :: (Functor m, MonadIO m) => m Spawner
-mkSpawner = io . fmap Spawner $ newIORef []
+-- | 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)
 
-manageSpawn :: Spawner -> ManageHook
-manageSpawn sp = do
-    pids <- io . readIORef $ pidsRef sp
+-- | 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
-        Just w -> doF (W.shift w)
-        Nothing -> doF id
+        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
 
-shellPromptHere :: Spawner -> XPConfig -> X ()
-shellPromptHere sp = mkPrompt (spawnHere sp)
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on current workspace.
+shellPromptHere :: XPConfig -> X ()
+shellPromptHere = mkPrompt spawnHere
 
-shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()
-shellPromptOn sp ws = mkPrompt (spawnOn sp ws)
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on given workspace.
+shellPromptOn :: WorkspaceId -> XPConfig -> X ()
+shellPromptOn ws = mkPrompt (spawnOn ws)
 
-spawnHere :: Spawner -> String -> X ()
-spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (currTag ws) cmd
- where currTag = W.tag . W.workspace . W.current
+-- | Replacement for 'spawn' which launches
+-- application on current workspace.
+spawnHere :: String -> X ()
+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
 
-spawnOn :: Spawner -> WorkspaceId -> String -> X ()
-spawnOn sp ws cmd = do
-    p <- spawnPID cmd
-    io $ modifyIORef (pidsRef sp) (take maxPids . ((p, ws) :))
+-- | 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

@@ -19,7 +19,7 @@ module XMonad.Actions.SwapWorkspaces (
                                      swapWithCurrent,
                                      swapTo,
                                      swapWorkspaces,
-                                     WSDirection(..)
+                                     Direction1D(..)
                                     ) where
 
 import XMonad (windows, X())
@@ -36,7 +36,7 @@ import XMonad.Util.WorkspaceCompare
 -- 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
@@ -52,7 +52,7 @@ 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 :: WSDirection -> X ()
+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

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

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,8 +24,10 @@ module XMonad.Actions.UpdatePointer
     where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Control.Monad
-import XMonad.StackSet (member)
+import XMonad.StackSet (member, peek, screenDetail, current)
+import Data.Maybe
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -34,9 +36,9 @@ import XMonad.StackSet (member)
 -- > 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)
@@ -50,43 +52,54 @@ import XMonad.StackSet (member)
 --
 -- 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, or unless the user was changing
+-- 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
   mouseIsMoving <- asks mouseFocused
-  wa <- io $ getWindowAttributes dpy w
   (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
-  unless (pointWithinRegion rootx rooty (wa_x wa) (wa_y wa) (wa_width wa) (wa_height wa)
+  drag <- gets dragging
+  unless (pointWithin (fi rootx) (fi rooty) rect
           || mouseIsMoving
-          || not (currentWindow `member` ws)) $
+          || 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
-
--- Test that a point resides within a region. 
--- This belongs somewhere more generally accessible than this module.
-pointWithinRegion :: Integral a => a -> a -> a -> a -> a -> a -> Bool
-pointWithinRegion px py rx ry rw rh =
-    within px rx (rx + rw) && within py ry (ry + rh)
-    where within x left right = x >= left && x <= right
+         else now

XMonad/Actions/Warp.hs

@@ -22,7 +22,6 @@ module XMonad.Actions.Warp (
                            warpToWindow
                           ) where
 
-import Data.Ratio
 import Data.List
 import XMonad
 import XMonad.StackSet as W
@@ -34,11 +33,11 @@ You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 
 then add appropriate keybindings to warp the pointer; for example:
 
-> , ((modMask x,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+> , ((modm,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
 >
 >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
 >
->   [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+>   [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2))
 >       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
 
 Note that warping to a particular screen may change the focus.

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,11 +15,13 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.WindowBringer (
-				    -- * Usage
-				    -- $usage
-				    gotoMenu, gotoMenu', bringMenu, windowMap,
-				    bringWindow
-				   ) where
+                    -- * Usage
+                    -- $usage
+                    gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',
+                    bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',
+                    windowMap,
+                    bringWindow
+                   ) where
 
 import Data.Char (toLower)
 import qualified Data.Map as M
@@ -27,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 (menuMap)
+import XMonad.Util.Dmenu (menuMapArgs)
 import XMonad.Util.NamedWindows (getName)
 
 -- $usage
@@ -38,25 +40,60 @@ 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 = actionMenu W.focusWindow
+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 = actionMenu' menuCmd W.focusWindow
+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 = actionMenu bringWindow
+bringMenu = bringMenuArgs []
+
+-- | 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
+
+-- | 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
@@ -64,14 +101,11 @@ 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 :: (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu action = actionMenu' "dmenu" action
-
-actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
+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 = menuMap menuCmd selectionMap
+      menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap
 
 -- | A map from window names to Windows.
 windowMap :: X (M.Map String Window)

XMonad/Actions/WindowGo.hs

@@ -28,18 +28,23 @@ module XMonad.Actions.WindowGo (
                  runOrRaiseMaster,
                  raiseAndDo,
                  raiseMaster,
+
+                 ifWindows,
+                 ifWindow,
+                 raiseHook,
                  module XMonad.ManageHook
                 ) where
 
-import Control.Monad (filterM)
+import Control.Monad
 import Data.Char (toLower)
-
-import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO)
+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@:
@@ -48,31 +53,50 @@ 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\")@.)
+appropriate one, or cover your bases by using instead something like:
+
+> (className =? "Firefox" <||> className =? "Firefox-bin")
 
 For detailed instructions on editing your key bindings, see
 "XMonad.Doc.Extending#Editing_key_bindings". -}
 
--- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") 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 = raiseMaybe . spawn
+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
+   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\")@.
 
@@ -95,15 +119,15 @@ raise = raiseMaybe $ return ()
   > , ((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:_)  -> windows $ W.focusWindow 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 . spawn
+runOrRaiseNext = raiseNextMaybe . safeSpawnProg
 
 -- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches.
 raiseNext :: Query Bool -> X ()
@@ -115,18 +139,14 @@ raiseNext = raiseNextMaybe $ return ()
      query the next matching window is raised. If no matches are found
      the function f is executed.
 -}
+
 raiseNextMaybe :: X () -> Query Bool -> X ()
-raiseNextMaybe f thatUserQuery = withWindowSet $ \s -> do
-  ws <- filterM (runQuery thatUserQuery) (W.allWindows s)
-  case ws of
-    []    -> f
-    (x:_) -> let go (Just w) | (w `elem` ws) = next w $ cycle ws
-                 go _ = windows $ W.focusWindow x
-             in go $ W.peek s
-  where
-    next w (x:y:_) | x==w = windows $ W.focusWindow y
-    next w (_:xs)         = next w xs
-    next _ _ = error "raiseNextMaybe: empty list"
+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.
@@ -135,38 +155,34 @@ raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) c
 
 {- | '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'. -}
+     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
+{- | 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 raisef thatUserQuery afterRaise = withWindowSet $ \s -> do
-    maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s)
-    case maybeResult of
-      []     -> raisef
-      (x:_)  -> do windows $ W.focusWindow x
-                   afterRaise x
+     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 the window is found the window is focused and the third argument is called
-     otherwise, raisef is called -}
+{- | 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 . spawn
+runOrRaiseAndDo = raiseAndDo . safeSpawnProg
 
 {- | if the window is found the window is focused and set to master
-     otherwise, the first argument is called
+     otherwise, the first argument is called.
 
-     raiseMaster (runInTerm \"-title ghci\"  \"zsh -c \'ghci\'\") (title =? \"ghci\") -}
+     > 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
+{- |  If the window is found the window is focused and set to master
+      otherwise, action is run.
 
-      runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) 
+      > 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

@@ -5,6 +5,8 @@
 --                          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
@@ -34,11 +36,11 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
-                                       Direction(..)
+                                       Direction2D(..), WNState,
                                        ) where
 
 import XMonad
-import XMonad.Hooks.ManageDocks (Direction(..))
+import XMonad.Util.Types (Direction2D(..))
 import qualified XMonad.StackSet as W
 
 import Control.Applicative ((<$>))
@@ -50,7 +52,6 @@ import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Data.Ord (comparing)
 import qualified Data.Set as S
-import Graphics.X11.Xlib
 
 -- $usage
 --
@@ -84,15 +85,15 @@ import Graphics.X11.Xlib
 --  - manageHook to draw window decos?
 
 withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
-withWindowNavigation (u,l,d,r) conf =
-    withWindowNavigationKeys [ ((modMask conf              , u), WNGo   U),
-                               ((modMask conf              , l), WNGo   L),
-                               ((modMask conf              , d), WNGo   D),
-                               ((modMask conf              , r), WNGo   R),
-                               ((modMask conf .|. shiftMask, u), WNSwap U),
-                               ((modMask conf .|. shiftMask, l), WNSwap L),
-                               ((modMask conf .|. shiftMask, d), WNSwap D),
-                               ((modMask conf .|. shiftMask, r), WNSwap R) ]
+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)
@@ -104,7 +105,7 @@ withWindowNavigationKeys wnKeys conf = do
   where fromWNAction posRef (WNGo dir)   = go   posRef dir
         fromWNAction posRef (WNSwap dir) = swap posRef dir
 
-data WNAction = WNGo Direction | WNSwap Direction
+data WNAction = WNGo Direction2D | WNSwap Direction2D
 
 type WNState = Map WorkspaceId Point
 
@@ -113,10 +114,10 @@ type WNState = Map WorkspaceId Point
 -- 2. get target windowrect
 -- 3. focus window
 -- 4. set new position
-go :: IORef WNState -> Direction -> X ()
+go :: IORef WNState -> Direction2D -> X ()
 go = withTargetWindow W.focusWindow
 
-swap :: IORef WNState -> Direction -> X ()
+swap :: IORef WNState -> Direction2D -> X ()
 swap = withTargetWindow swapWithFocused
   where swapWithFocused targetWin winSet =
             case W.peek winSet of
@@ -128,7 +129,7 @@ swap = withTargetWindow swapWithFocused
         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 -> Direction -> X ()
+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
@@ -175,12 +176,12 @@ Point x y `inside` Rectangle rx ry rw rh =
 midPoint :: Position -> Dimension -> Position
 midPoint pos dim = pos + fromIntegral dim `div` 2
 
-navigableTargets :: Point -> Direction -> X [(Window, Rectangle)]
+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 Direction.
-navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
+-- 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
@@ -197,7 +198,7 @@ windowRect win = withDisplay $ \dpy -> do
 
 -- Modified from droundy's implementation of WindowNavigation:
 
-inr :: Direction -> Point -> Rectangle -> Bool
+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 &&
@@ -207,7 +208,7 @@ inr R (Point px py) (Rectangle rx ry _ h) = px <  rx &&
 inr L (Point px py) (Rectangle rx ry w h) =             px > rx + fromIntegral w &&
                                             py >= ry && py < ry + fromIntegral h
 
-sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)]
+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

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
@@ -90,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
@@ -99,6 +99,7 @@ arossatoConfig = do
          , normalBorderColor  = "white"
          , focusedBorderColor = "black"
          , keys               = newKeys
+         , handleEventHook    = serverModeEventHook
          , focusFollowsMouse  = False
          }
     where

XMonad/Config/Azerty.hs

@@ -7,6 +7,8 @@
 -- 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
@@ -36,7 +38,7 @@ import qualified Data.Map as M
 -- > import qualified Data.Map as M
 -- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
 
-azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }
+azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig }
 
 azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]

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

@@ -7,29 +7,170 @@
 -- License      : BSD
 --
 -- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    :  unstable
+-- Portability  :  unportable
 --
 -- This module provides a config suitable for use with a desktop
 -- environment such as KDE or GNOME.
-
+-----------------------------------------------------------------------------
 module XMonad.Config.Desktop (
+
+    -- | Several basic integration settings are common to all of xmonad's
+    -- desktop integration configurations. The specific desktop environment
+    -- (DE) modules like "XMonad.Config.Gnome" use this module's
+    -- @desktopConfig@ to set up basic communication between xmonad and
+    -- the DE via a subset of the Extended Window Manager Hints (EWMH)
+    -- specification. Extra xmonad settings unique to specific DE's are
+    -- added by overriding or modifying @desktopConfig@ fields in the
+    -- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@.
+    --
+    -- For more information about EWMH see:
+    --
+    -- <http://standards.freedesktop.org/wm-spec/wm-spec-latest.html>
+    --
+    -- See also: "XMonad.Hooks.EwmhDesktops", "XMonad.Hooks.ManageDocks",
+    -- "XMonad.Util.EZConfig".
+
+    -- * Usage
+    -- $usage
+
     desktopConfig,
+
+    -- * Customizing a desktop config
+    -- $customizing
+
+    -- ** Modifying layouts, manageHook, or key bindings
+    -- $layouts
     desktopLayoutModifiers
+
+    -- ** Modifying the logHook
+    -- $logHook
+
+    -- ** Modifying the handleEventHook
+    -- $eventHook
+
+    -- ** Modifying the startupHook
+    -- $startupHook
     ) where
 
 import XMonad
-import XMonad.Config (defaultConfig)
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
+import XMonad.Util.Cursor
 
 import qualified Data.Map as M
 
-desktopConfig = defaultConfig
-    { logHook    = ewmhDesktopsLogHook
-    , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
-    , manageHook = manageHook defaultConfig <+> manageDocks
-    , keys       = \c -> desktopKeys c `M.union` keys defaultConfig c }
+-- $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 $ ewmhDesktopsLayout layout
+desktopLayoutModifiers layout = avoidStruts layout
+

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
@@ -22,7 +22,7 @@ import XMonad.Layout.Combo ( combineTwo )
 import XMonad.Layout.Named ( named )
 import XMonad.Layout.LayoutCombinators
 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 )
@@ -40,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-*-*-*-*-*-*-*"
@@ -95,7 +94,7 @@ 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
@@ -112,16 +111,16 @@ keys x = M.fromList $
     , ((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 "~" $
+         , layoutHook = showWName $ workspaceDir "~" $
                         boringWindows $ smartBorders $ windowNavigation $
                         maximizeVertical $ toggleLayouts Full $ avoidStruts $
                         named "tabbed" mytab |||
@@ -131,7 +130,6 @@ 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 = "#222222" -- Border color for unfocused windows.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
@@ -142,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

XMonad/Config/Gnome.hs

@@ -7,6 +7,8 @@
 -- 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.
@@ -15,14 +17,18 @@ module XMonad.Config.Gnome (
     -- * Usage
     -- $usage
     gnomeConfig,
-    gnomeRun
+    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@:
 --
@@ -30,11 +36,13 @@ import qualified Data.Map as M
 -- > import XMonad.Config.Gnome
 -- >
 -- > main = xmonad gnomeConfig
--- 
+--
+-- For examples of how to further customize @gnomeConfig@ see "XMonad.Config.Desktop".
 
 gnomeConfig = desktopConfig
     { terminal = "gnome-terminal"
-    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c }
+    , keys     = gnomeKeys <+> keys desktopConfig
+    , startupHook = gnomeRegister >> startupHook desktopConfig }
 
 gnomeKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_p), gnomeRun)
@@ -53,3 +61,22 @@ gnomeRun = withDisplay $ \dpy -> do
         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

@@ -7,6 +7,8 @@
 -- 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.
@@ -32,15 +34,17 @@ import qualified Data.Map as M
 -- > main = xmonad kdeConfig
 --
 -- For KDE 4, replace 'kdeConfig' with 'kde4Config'
--- 
+--
+-- For examples of how to further customize @kdeConfig@ see "XMonad.Config.Desktop".
+
 
 kdeConfig = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }
+    , keys     = kdeKeys <+> keys desktopConfig }
 
 kde4Config = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }
+    , keys     = kde4Keys <+> keys desktopConfig }
 
 kdeKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")

XMonad/Config/Monad.hs

@@ -38,7 +38,7 @@ 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 :: Accessor (XConfig LayoutList) a -> a -> Config ()
 set r x = tell (mkW $ r ^= x)
 add r x = tell (mkW (r ^: mappend x))
 

XMonad/Config/Sjanssen.hs

@@ -1,58 +1,64 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) where
+module XMonad.Config.Sjanssen (sjanssenConfig) where
 
 import XMonad hiding (Tall(..))
 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 hiding (xmobar)
+import XMonad.Hooks.DynamicLog
 import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Prompt
 import XMonad.Actions.SpawnOn
+import XMonad.Util.SpawnOnce
 
 import XMonad.Layout.LayoutScreens
 import XMonad.Layout.TwoPane
 
 import qualified Data.Map as M
 
-sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey =<< sjanssenConfig
- where
-    strutkey (XConfig {modMask = modm}) = (modm, xK_b)
-
-sjanssenConfig = do
-    sp <- mkSpawner
-    return $ defaultConfig
-        { terminal = "urxvtc"
+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 sp c `M.union` keys defaultConfig c
-        , layoutHook = modifiers layouts
-        , logHook    = ewmhDesktopsLogHook
-        , manageHook = composeAll [className =? x --> doF (W.shift w)
+        , keys = \c -> mykeys c `M.union` keys defaultConfig c
+        , 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 sp
+                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
+                        <+> (isFullscreen --> doFullFloat)
+        , startupHook = mapM_ spawnOnce spawns
         }
  where
     tiled     = HintedTile 1 0.03 0.5 TopLeft
     layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
-    modifiers = smartBorders
+    modifiers = avoidStruts . smartBorders
 
-    mykeys sp (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
-        [((modm,               xK_p     ), shellPromptHere sp 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 .|. 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"

XMonad/Config/Xfce.hs

@@ -6,7 +6,9 @@
 -- Copyright    : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
 -- License      : BSD
 --
--- Maintainer   : Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
+-- Maintainer   :  none
+-- Stability    :  unstable
+-- Portability  :  unportable
 --
 -- This module provides a config suitable for use with the Xfce desktop
 -- environment.
@@ -29,11 +31,12 @@ import qualified Data.Map as M
 -- > import XMonad.Config.Xfce
 -- >
 -- > main = xmonad xfceConfig
--- 
+--
+-- For examples of how to further customize @xfceConfig@ see "XMonad.Config.Desktop".
 
 xfceConfig = desktopConfig
     { terminal = "Terminal"
-    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }
+    , keys     = xfceKeys <+> keys desktopConfig }
 
 xfceKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "xfrun4")

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

@@ -256,6 +256,9 @@ xmonad contributed extensions.
 * 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 never call 'error' or 'undefined'.
 

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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.DynamicHooks
@@ -15,20 +16,18 @@
 module XMonad.Hooks.DynamicHooks (
   -- * Usage
   -- $usage
-  initDynamicHooks
-  ,dynamicMasterHook
+  dynamicMasterHook
   ,addDynamicHook
   ,updateDynamicHook
   ,oneShotHook
   ) where
 
 import XMonad
-import System.IO
+import qualified XMonad.Util.ExtensibleState as XS
 
 import Data.List
 import Data.Maybe (listToMaybe)
 import Data.Monoid
-import Data.IORef
 
 -- $usage
 -- Provides two new kinds of 'ManageHooks' that can be defined at runtime.
@@ -40,83 +39,55 @@ import Data.IORef
 -- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!
 -- If you want them to last, you should create them as normal in your @xmonad.hs@.
 --
--- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:
+-- To use this module, add 'dynamicMasterHook' to your 'manageHook':
 --
--- > dynHooksRef <- initDynamicHooks
+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook }
 --
--- and then pass this value to the other functions in this module.
+-- You can then use the supplied functions in your keybindings:
 --
--- You also need to add the base 'ManageHook':
---
--- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }
---
--- You must include this @dynHooksRef@ value when using the functions in this
--- module:
---
--- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList 
--- >                   [((modMask conf, xK_i), oneShotHook dynHooksRef 
--- >                    "FFlaunchHook" (className =? "firefox") (doShift "3") 
--- >                    >> spawn "firefox")
--- >                   ,((modMask conf, xK_u), addDynamicHook dynHooksRef 
--- >                     (className =? "example" --> doFloat))
--- >                   ,((modMask conf, xK_y), updatePermanentHook dynHooksRef
--- >                     (const idHook))) ]  -- resets the permanent hook.
+-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat)
 --
 
 data DynamicHooks = DynamicHooks
     { transients :: [(Query Bool, ManageHook)]
     , permanent  :: ManageHook }
-      
+                    deriving Typeable
 
--- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.
-initDynamicHooks :: IO (IORef DynamicHooks)
-initDynamicHooks = newIORef (DynamicHooks { transients = [],
-                                            permanent = idHook })
+instance ExtensionClass DynamicHooks where
+    initialValue = DynamicHooks [] idHook
 
-
--- this hook is always executed, and the IORef's contents checked.
+-- 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 :: IORef DynamicHooks -> ManageHook
-dynamicMasterHook ref = return True --> 
-                  (ask >>= \w -> liftX (do
-  dh <- io $ readIORef ref
+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
-  io $ writeIORef ref $ dh { transients = map snd nts }
+  XS.put $ dh { transients = map snd nts }
   return $ Endo $ f . g
                                        ))
-
 -- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
-addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()
-addDynamicHook ref m = updateDynamicHook ref (<+> m)
-
+addDynamicHook :: ManageHook -> X ()
+addDynamicHook m = updateDynamicHook (<+> m)
 
 -- | Modifies the permanent 'ManageHook' with an arbitrary function.
-updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()
-updateDynamicHook ref f = 
-    io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }
-
+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 
+-- you must call 'oneShotHook' as
 --
 -- > oneShotHook dynHooksRef (className =? "example) doFloat
--- 
-oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()
-oneShotHook ref q a =
-  io $ modifyIORef ref
-         $ \dh -> dh { transients = (q,a):(transients dh) }
-
-
-
-
+--
+oneShotHook :: Query Bool -> ManageHook -> X ()
+oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }

XMonad/Hooks/DynamicLog.hs

@@ -29,6 +29,9 @@ module XMonad.Hooks.DynamicLog (
     dynamicLog,
     dynamicLogXinerama,
 
+    xmonadPropLog',
+    xmonadPropLog,
+
     -- * Build your own formatter
     dynamicLogWithPP,
     dynamicLogString,
@@ -38,8 +41,9 @@ module XMonad.Hooks.DynamicLog (
     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,
@@ -50,23 +54,26 @@ module XMonad.Hooks.DynamicLog (
 
   ) where
 
---
 -- Useful imports
---
-import XMonad
-import Control.Monad
+
+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 qualified Data.Map as M
 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.Util.Font
 import XMonad.Hooks.UrgencyHook
 import XMonad.Hooks.ManageDocks
 
@@ -79,7 +86,9 @@ import XMonad.Hooks.ManageDocks
 -- If you just want a quick-and-dirty status bar with zero effort, try
 -- the 'xmobar' or 'dzen' functions:
 --
--- > main = xmonad =<< xmobar conf
+-- > main = xmonad =<< xmobar myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
 --
 -- 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
@@ -142,7 +151,9 @@ import XMonad.Hooks.ManageDocks
 
 -- | Run xmonad with a dzen status bar set to some nice defaults.
 --
--- > main = xmonad =<< dzen conf
+-- > main = xmonad =<< dzen myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
 --
 -- The intent is that the above config file should provide a nice
 -- status bar with minimal effort.
@@ -165,7 +176,9 @@ dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
 
 -- | Run xmonad with a xmobar status bar set to some nice defaults.
 --
--- > main = xmonad =<< xmobar conf
+-- > main = xmonad =<< xmobar myConfig
+-- >
+-- > myConfig = defaultConfig { ... }
 --
 -- This works pretty much the same as 'dzen' function above.
 --
@@ -196,6 +209,24 @@ statusBar cmd pp k conf = do
  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
 --
@@ -243,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 $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $
+    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
                         [ ws
                         , ppLayout pp ld
                         , ppTitle  pp wt
@@ -262,9 +293,9 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
          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
 
@@ -276,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
 
@@ -302,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 = "..."
 
@@ -332,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
@@ -343,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
@@ -358,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)
@@ -418,27 +478,28 @@ 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
@@ -454,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
@@ -463,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,107 +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 Data.Maybe
-
-import XMonad
-import XMonad.StackSet (Workspace (..), currentTag)
-
--- $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       <- gets (currentTag . 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,22 +15,27 @@
 module XMonad.Hooks.EwmhDesktops (
     -- * Usage
     -- $usage
-    EwmhDesktopsHook,
+    ewmh,
+    ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
-    ewmhDesktopsLayout
+    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@:
@@ -38,34 +43,29 @@ import XMonad.Hooks.EventHook
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > myLogHook :: X ()
--- > myLogHook = ewmhDesktopsLogHook
--- >
--- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig
--- >
--- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
+-- > main = xmonad $ ewmh defaultConfig
 --
--- 'avoidStruts' is used to automatically leave space for dock programs, and
--- can be found in 'XMonad.Hooks.ManageDocks'.
---
--- 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 = ewmhDesktopsLogHookCustom id
-
-
 -- |
 -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
 -- user-specified function to transform the workspace list (post-sorting)
@@ -74,8 +74,6 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
     sort' <- getSortByIndex
     let ws = f $ sort' $ W.workspaces s
 
-    setSupported
-
     -- Number of Workspaces
     setNumberOfDesktops (length ws)
 
@@ -100,7 +98,7 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
                 setWindowDesktop win curr
 
     forM_ (W.hidden s) $ \w ->
-        case elemIndex (W.tag w) (map W.tag ws) of 
+        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
@@ -119,13 +117,8 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
 --
 --  * _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 {
@@ -142,24 +135,57 @@ handle ClientMessageEvent {
        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 if mt == a_cw then do
                killWindow w
         else if mt `elem` a_ignore then do
-	       return ()
-        else trace $ "Unknown ClientMessageEvent " ++ show mt
-handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match
+           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
@@ -181,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 ()

XMonad/Hooks/FadeInactive.hs

@@ -16,12 +16,17 @@ module XMonad.Hooks.FadeInactive (
     -- * Usage
     -- $usage
     setOpacity,
-    fadeInactiveLogHook
+    isUnfocused,
+    fadeIn,
+    fadeOut,
+    fadeIf,
+    fadeInactiveLogHook,
+    fadeOutLogHook
     ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
-import Control.Monad (forM_)
+import Control.Monad
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -31,15 +36,15 @@ import Control.Monad (forM_)
 -- >
 -- > myLogHook :: X ()
 -- > myLogHook = fadeInactiveLogHook fadeAmount
--- >     where fadeAmount = 0xdddddddd
+-- >     where fadeAmount = 0.8
 -- >
 -- > main = xmonad defaultConfig { logHook = myLogHook }
 --
--- fadeAmount can be any integer
+-- fadeAmount can be any rational between 0 and 1.
 -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
 -- or something similar for this to do anything
 --
--- For more detailed instructions on editing the layoutHook see:
+-- For more detailed instructions on editing the logHook see:
 --
 -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
 --
@@ -47,31 +52,43 @@ import Control.Monad (forM_)
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
--- |
--- sets the opacity of a window
-setOpacity :: Window -> Integer -> X ()
+-- | 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 [fromIntegral t]
+    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
--- |
--- fades a window out by setting the opacity
-fadeOut :: Integer -> Window -> X ()
-fadeOut amt = flip setOpacity amt
+-- | fades a window out by setting the opacity
+fadeOut :: Rational -> Window -> X ()
+fadeOut = flip setOpacity
 
--- |
--- makes a window completely opaque
+-- | makes a window completely opaque
 fadeIn :: Window -> X ()
-fadeIn = flip setOpacity 0xffffffff
+fadeIn = fadeOut 1
 
--- |
--- lowers the opacity of inactive windows to the specified amount
-fadeInactiveLogHook :: Integer -> X ()
-fadeInactiveLogHook amt = withWindowSet $ \s ->
-    forM_ (visibleWins s) (fadeOut amt) >>
-    withFocused fadeIn
-        where
-          visibleWins s = (maybe [] unfocused . W.stack . W.workspace) (W.current s) ++
-                          concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
-          unfocused (W.Stack _ l r) = l ++ r
+-- | 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
@@ -18,17 +17,32 @@ module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
     manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
-    ToggleStruts(..), Direction(..)
+    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 Data.List (delete)
+import qualified Data.Set as S
 
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -49,15 +63,20 @@ import Data.List (delete)
 -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
 -- >                   where  tall = Tall 1 (3/100) (1/2)
 --
+-- The third component is an event hook that causes new docks to appear
+-- immediately, instead of waiting for the next focus change.
+--
+-- > handleEventHook = ... <+> docksEventHook
+--
 -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
 -- similar to:
 --
--- > ,((modMask x, xK_b     ), sendMessage ToggleStruts)
+-- > ,((modm, xK_b     ), sendMessage ToggleStruts)
 --
 -- If you have multiple docks, you can toggle their gaps individually.
 -- For example, to toggle only the top gap:
 --
--- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut U)
+-- > ,((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.
@@ -79,18 +98,6 @@ import Data.List (delete)
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 --
 
--- | An enumeration of the four cardinal directions\/sides of the
---   screen.
---
---   Ideally this would go in its own separate module in Util,
---   but ManageDocks is angling for inclusion into the xmonad core,
---   so keep the dependencies to a minimum.
-data Direction = U   -- ^ Up\/top
-               | D   -- ^ Down\/bottom
-               | R   -- ^ Right
-               | L   -- ^ Left
-  deriving ( Read, Show, Eq, Ord, Enum, Bounded )
-
 -- | 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.
@@ -100,23 +107,28 @@ manageDocks = checkDock --> doIgnore
 -- | 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
 
+-- | 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 _ = []
@@ -126,13 +138,9 @@ getStrut w = do
         [(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 :: [Direction] -> X (Rectangle -> Rectangle)
+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
@@ -145,7 +153,7 @@ calcGap ss = 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 `elem` ss
+  where careAbout (s,_,_,_) = s `S.member` ss
 
 -- | Adjust layout automagically: don't cover up any docks, status
 --   bars, etc.
@@ -156,78 +164,100 @@ avoidStruts = avoidStrutsOn [U,D,L,R]
 --   etc. on the indicated sides of the screen.  Valid sides are U
 --   (top), D (bottom), R (right), or L (left).
 avoidStrutsOn :: LayoutClass l a =>
-                 [Direction]
+                 [Direction2D]
               -> l a
               -> ModifiedLayout AvoidStruts l a
-avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss)
+avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss
 
-data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show )
+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 Direction
+                  | ToggleStrut Direction2D
   deriving (Read,Show,Typeable)
 
 instance Message ToggleStruts
 
+-- | SetStruts is a message constructor used to set or unset specific struts,
+-- regardless of whether or not the struts were originally set. Here are some
+-- example bindings:
+--
+-- Show all gaps:
+--
+-- >   ,((modm .|. shiftMask  ,xK_b),sendMessage $ SetStruts [minBound .. maxBound] [])
+--
+-- Hide all gaps:
+--
+-- >   ,((modm .|. controlMask,xK_b),sendMessage $ SetStruts [] [minBound .. maxBound])
+--
+-- Show only upper and left gaps:
+--
+-- >   ,((modm .|. controlMask .|. shiftMask,xK_b),sendMessage $ SetStruts [U,L] [minBound .. maxBound])
+--
+-- Hide the bottom keeping whatever the other values were:
+--
+-- >   ,((modm .|. controlMask .|. shiftMask,xK_g),sendMessage $ SetStruts [] [D])
+data SetStruts = SetStruts { addedStruts   :: [Direction2D]
+                           , removedStruts :: [Direction2D] -- ^ These are removed from the currently set struts before 'addedStruts' are added.
+                           }
+  deriving (Read,Show,Typeable)
+
+instance Message SetStruts
+
 instance LayoutModifier AvoidStruts a where
     modifyLayout (AvoidStruts ss) w r = do
         nr <- fmap ($ r) (calcGap ss)
         runLayout w nr
 
-    handleMess (AvoidStruts ss) m
-        | Just ToggleStruts    <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss)
-        | Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss)
-        | otherwise = return Nothing
-      where toggleAll []   = [U,D,L,R]
-            toggleAll _    = []
-            toggleOne x xs | x `elem` xs = delete x xs
-                           | otherwise   = x : xs
+    pureMess (AvoidStruts ss) m
+        | Just ToggleStruts    <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
+        | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
+        | Just (SetStruts n k) <- fromMessage m
+        , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
+        , newSS /= ss = Just $ AvoidStruts newSS
+        | otherwise = Nothing
+      where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
+                        | otherwise = S.empty
+            toggleOne x xs | x `S.member` xs = S.delete x xs
+                           | otherwise   = x `S.insert` xs
 
 
 -- | (Direction, height\/width, initial pixel, final pixel).
 
-type Strut = (Direction, 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       )
-    U | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )
-    D | 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

@@ -28,6 +28,8 @@ module XMonad.Hooks.ManageHelpers (
     Side(..),
     composeOne,
     (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
+    currentWs,
+    isInProperty,
     isKDETrayWindow,
     isFullscreen,
     isDialog,
@@ -41,18 +43,22 @@ module XMonad.Hooks.ManageHelpers (
     doFullFloat,
     doCenterFloat,
     doSideFloat,
-    doHideIgnore
+    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 Northwest
+-- | 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)
@@ -114,44 +120,39 @@ 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 = ask >>= \w -> liftX $ do
-    dpy <- asks display
-    state <- getAtom "_NET_WM_STATE"
-    full <- getAtom "_NET_WM_STATE_FULLSCREEN"
-    r <- io $ getWindowProperty32 dpy state w
-    return $ case r of
-        Just xs -> fromIntegral full `elem` xs
-        _ -> False
+isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN"
 
 -- | A predicate to check whether a window is a dialog.
 isDialog :: Query Bool
-isDialog = ask >>= \w -> liftX $ do
-    dpy <- asks display
-    w_type <- getAtom "_NET_WM_WINDOW_TYPE"
-    w_dialog <- getAtom "_NET_WM_WINDOW_TYPE_DIALOG"
-    r <- io $ getWindowProperty32 dpy w_type w
-    return $ case r of
-        Just xs -> fromIntegral w_dialog `elem` xs
-        _ -> False
+isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
 
 pid :: Query (Maybe ProcessID)
 pid = ask >>= \w -> liftX $ do
-    dpy <- asks display
-    a <- getAtom "_NET_WM_PID"
-    p <- io $ getWindowProperty32 dpy a w
+    p <- getProp32s "_NET_WM_PID" w
     return $ case p of
         Just [x] -> Just (fromIntegral x)
         _        -> Nothing
@@ -192,19 +193,31 @@ doRectFloat r = ask >>= \w -> doF (W.float w r)
 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 = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w)
-    where
+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
+      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

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

@@ -26,7 +26,6 @@ module XMonad.Hooks.Script (
 --
 import XMonad
 
-import Control.Monad.Trans
 import System.Directory
 
 -- $usage
@@ -43,7 +42,7 @@ import System.Directory
 -- >   ...
 -- >   }
 --
--- Now, everytime the startup hook runs, the command
+-- Now, every time the startup hook runs, the command
 -- @~\/.xmonad\/hooks startup@ will also.
 
 -- | Execute a named 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/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 #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -64,25 +65,24 @@ module XMonad.Hooks.UrgencyHook (
                                  readUrgents, withUrgents,
                                  StdoutUrgencyHook(..),
                                  SpawnUrgencyHook(..),
-                                 UrgencyHook(urgencyHook)
+                                 UrgencyHook(urgencyHook),
+                                 Interval,
                                  ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import XMonad.Hooks.EventHook
 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)
-import Data.IORef
-import Data.List (delete)
+import Data.List (delete, (\\))
 import Data.Maybe (listToMaybe, maybeToList)
 import qualified Data.Set as S
-import Foreign (unsafePerformIO)
 
 -- $usage
 --
@@ -139,7 +139,7 @@ import Foreign (unsafePerformIO)
 --    two parts:
 --
 --      * The console app must send a ^G (bell). In bash, a helpful trick is
---        @sleep 1; echo -e \'\a\'@.
+--        @sleep 1; echo -e \'\\a\'@.
 --
 --      * The terminal must convert the bell into UrgencyHint.
 --
@@ -196,10 +196,10 @@ import Foreign (unsafePerformIO)
 -- hopefully you know where to find it.
 
 -- | This is the method to enable an urgency hook. It uses the default
--- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'
+-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHookC'
 -- instead.
 withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
-                   h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
+                   h -> XConfig l -> XConfig l
 withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
 
 -- | This lets you modify the defaults set in 'urgencyConfig'. An example:
@@ -208,12 +208,21 @@ withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
 --
 -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.
 withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
-                    h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l)
+                    h -> UrgencyConfig -> XConfig l -> XConfig l
 withUrgencyHookC hook urgConf conf = conf {
-        layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook 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
@@ -252,36 +261,29 @@ urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
 -- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
 -- Example keybinding:
 --
--- > , ((modMask              , xK_BackSpace), focusUrgent)
+-- > , ((modm              , xK_BackSpace), focusUrgent)
 focusUrgent :: X ()
 focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe
 
 -- | Just makes the urgents go away.
 -- Example keybinding:
 --
--- > , ((modMask .|. shiftMask, xK_BackSpace), clearUrgents)
+-- > , ((modm .|. shiftMask, xK_BackSpace), clearUrgents)
 clearUrgents :: X ()
 clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])
 
--- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
--- 'readUrgents' or 'withUrgents' instead.
-{-# NOINLINE urgents #-}
-urgents :: IORef [Window]
-urgents = unsafePerformIO (newIORef [])
--- (Hey, I don't like it any more than you do.)
-
 -- | 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
 
 adjustUrgents :: ([Window] -> [Window]) -> X ()
-adjustUrgents f = io $ modifyIORef urgents f
+adjustUrgents = XS.modify . onUrgents
 
 type Interval = Rational
 
@@ -291,18 +293,19 @@ data Reminder = Reminder { timer     :: TimerId
                          , window    :: Window
                          , interval  :: Interval
                          , remaining :: Maybe Int
-                         } deriving Eq
+                         } deriving (Show,Read,Eq,Typeable)
+
+instance ExtensionClass [Reminder] where
+    initialValue = []
+    extensionType = PersistentExtension
 
 -- | Stores the list of urgency reminders.
-{-# NOINLINE reminders #-}
-reminders :: IORef [Reminder]
-reminders = unsafePerformIO (newIORef [])
 
 readReminders :: X [Reminder]
-readReminders = io $ readIORef reminders
+readReminders = XS.get
 
 adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
-adjustReminders f = io $ modifyIORef reminders f
+adjustReminders = XS.modify
 
 clearUrgency :: Window -> X ()
 clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
@@ -322,9 +325,10 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
 -- 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 => EventHook (WithUrgencyHook h) where
-    handleEvent wuh event = case event of
-        PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
+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
               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
               if (testBit flags urgencyHintBit) then do
@@ -332,10 +336,10 @@ instance UrgencyHook h => EventHook (WithUrgencyHook h) where
                   callUrgencyHook wuh w
                 else
                   clearUrgency w
-              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
-        DestroyWindowEvent {ev_window = w} ->
+              userCodeDef () =<< asks (logHook . config)
+      DestroyWindowEvent {ev_window = w} ->
           clearUrgency w
-        _ ->
+      _ ->
           mapM_ handleReminder =<< readReminders
       where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
 
@@ -369,7 +373,9 @@ shouldSuppress :: SuppressWhen -> Window -> X Bool
 shouldSuppress sw w = elem w <$> suppressibleWindows sw
 
 cleanupUrgents :: SuppressWhen -> X ()
-cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw
+cleanupUrgents sw = do
+    sw' <- suppressibleWindows sw
+    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
 
 suppressibleWindows :: SuppressWhen -> X [Window]
 suppressibleWindows Visible  = gets $ S.toList . mapped

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

@@ -1,12 +1,12 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.BoringWindows
 -- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  none
+-- Maintainer  :  Adam Vogt <vogt.adam@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,51 +17,133 @@
 module XMonad.Layout.BoringWindows (
                                    -- * Usage
                                    -- $usage
-                                   boringWindows,
+                                   boringWindows, boringAuto,
                                    markBoring, clearBoring,
-                                   focusUp, focusDown
+                                   focusUp, focusDown, focusMaster,
+
+                                   UpdateBoring(UpdateBoring),
+                                   BoringMessage(Replace,Merge),
+                                   BoringWindows()
+
+                                   -- * Tips
+                                   -- ** variant of 'Full'
+                                   -- $simplest
                                   ) where
 
-import XMonad hiding (Point)
+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
-import XMonad.Layout.LayoutModifier
-import XMonad.Util.Invisible
 
-data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
-                       deriving ( Read, Show, Typeable )
+-- $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
 
-markBoring, clearBoring, focusUp, focusDown :: X ()
+-- | 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 FocusUp
-focusDown = sendMessage FocusDown
+focusUp = sendMessage UpdateBoring >> sendMessage FocusUp
+focusDown = sendMessage UpdateBoring >> sendMessage FocusDown
+focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster
 
-data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
+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 (I []))
+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
-    handleMessOrMaybeModifyIt (BoringWindows (I bs)) m
-        | Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs))
-        | Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I [])
-        | Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp'
-                                             return Nothing
-        | Just FocusDown <- fromMessage m =
-                            do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
+    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
-        where focusUp' (W.Stack t ls rs)
-                  | (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs)
-                  | otherwise = case skipBoring (reverse (t:rs)++ls) of
-                                (a,x:xs) -> W.Stack x xs a
-                                _ -> W.Stack t ls rs
-              skipBoring [] = ([],[])
-              skipBoring (x:xs) | x `elem` bs = case skipBoring xs of
-                                                (a,b) -> (x:a,b)
-                                | otherwise = ([],x:xs)
+        | 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
 
--- | reverse a stack: up becomes down and down becomes up.
-reverseStack :: W.Stack a -> W.Stack a
-reverseStack (W.Stack t ls rs) = W.Stack t rs ls
+-- | 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

@@ -3,15 +3,15 @@
 -- |
 -- Module      :  XMonad.Layout.CenteredMaster
 -- Copyright   :  (c) 2009 Ilya Portnov
--- License     :  GNU GPL v3 or any later
+-- 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 
+-- 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.
 --
 -----------------------------------------------------------------------------
@@ -21,7 +21,8 @@ module XMonad.Layout.CenteredMaster (
          -- $usage
 
          centerMaster,
-         topRightMaster
+         topRightMaster,
+         CenteredMaster, TopRightMaster,
          ) where
 
 import XMonad
@@ -30,22 +31,22 @@ 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. 
+-- 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 type for LayoutModifier
 data CenteredMaster a = CenteredMaster deriving (Read,Show)
 
 instance LayoutModifier CenteredMaster Window where
@@ -56,12 +57,12 @@ 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 
+-- | 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 
+-- | 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

XMonad/Layout/Circle.hs

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

XMonad/Layout/Column.hs

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

XMonad/Layout/Combo.hs

@@ -25,7 +25,7 @@ module XMonad.Layout.Combo (
 import Data.List ( delete, intersect, (\\) )
 import Data.Maybe ( isJust )
 import XMonad hiding (focus)
-import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
+import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )
 import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
 import qualified XMonad.StackSet as W ( differentiate )
 
@@ -51,10 +51,10 @@ import qualified XMonad.StackSet as W ( differentiate )
 -- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",
 -- and add the following key bindings (or something similar):
 --
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
--- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
+-- >    , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
 --
 -- For detailed instruction on editing the key binding see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -76,7 +76,7 @@ combineTwo = C2 [] []
 
 instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
     => LayoutClass (CombineTwo (l ()) l1 l2) a where
-    doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s)
+    runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
         where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
                               super' <- maybe super id `fmap`
@@ -93,12 +93,11 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
                                                              x -> case origws \\ x of
                                                                   [] -> init x
                                                                   _ -> x
-                         superstack = if focus s `elem` w2'
-                                      then Stack { focus=(), up=[], down=[()] }
-                                      else Stack { focus=(), up=[], down=[()] }
+                         superstack = Stack { focus=(), up=[], down=[()] }
                          s1 = differentiate f' (origws \\ w2')
                          s2 = differentiate f' w2'
-                         f' = focus s:delete (focus s) f
+                         f' = case s of (Just s') -> focus s':delete (focus s') f
+                                        Nothing -> f
                      ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput
                      (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
                      (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2

XMonad/Layout/ComboP.hs

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

XMonad/Layout/Cross.hs

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