From 36728ae60e3effdfe645a9a34cfd2e1067a37516 Mon Sep 17 00:00:00 2001
From: Adam Vogt <vogt.adam@gmail.com>
Date: Thu, 22 Oct 2009 06:11:26 +0200
Subject: Refer to modm as the current modMask

Ignore-this: d097c7dc1746c55e1d4078a7148f9d5a

This makes the config suggestions consistent with the current template.

darcs-hash:20091022041126-1499c-5dd63076fdd71a61276cfc8e648bada81d9cc586.gz
---
 XMonad/Actions/Commands.hs             |  2 +-
 XMonad/Actions/ConstrainedResize.hs    |  4 ++--
 XMonad/Actions/CopyWindow.hs           | 10 +++++-----
 XMonad/Actions/CycleRecentWS.hs        |  2 +-
 XMonad/Actions/CycleSelectedLayouts.hs |  2 +-
 XMonad/Actions/CycleWS.hs              | 26 +++++++++++++-------------
 XMonad/Actions/CycleWindows.hs         | 14 +++++++-------
 XMonad/Actions/DeManage.hs             |  2 +-
 XMonad/Actions/DwmPromote.hs           |  2 +-
 XMonad/Actions/DynamicWorkspaces.hs    | 14 +++++++-------
 XMonad/Actions/FindEmptyWorkspace.hs   |  4 ++--
 XMonad/Actions/FlexibleManipulate.hs   |  2 +-
 XMonad/Actions/FlexibleResize.hs       |  2 +-
 XMonad/Actions/FloatKeys.hs            | 10 +++++-----
 XMonad/Actions/FloatSnap.hs            | 22 +++++++++++-----------
 XMonad/Actions/FocusNth.hs             |  2 +-
 XMonad/Actions/GridSelect.hs           |  8 ++++----
 XMonad/Actions/MouseGestures.hs        |  2 +-
 XMonad/Actions/NoBorders.hs            |  2 +-
 XMonad/Actions/OnScreen.hs             |  4 ++--
 XMonad/Actions/PhysicalScreens.hs      |  2 +-
 XMonad/Actions/Promote.hs              |  2 +-
 XMonad/Actions/RotSlaves.hs            |  2 +-
 XMonad/Actions/SimpleDate.hs           |  2 +-
 XMonad/Actions/SinkAll.hs              |  2 +-
 XMonad/Actions/Submap.hs               |  2 +-
 XMonad/Actions/SwapWorkspaces.hs       |  2 +-
 XMonad/Actions/TagWindows.hs           | 18 +++++++++---------
 XMonad/Actions/TopicSpace.hs           | 12 ++++++------
 XMonad/Actions/Warp.hs                 |  4 ++--
 XMonad/Actions/WindowBringer.hs        |  4 ++--
 XMonad/Actions/WindowGo.hs             |  4 ++--
 XMonad/Actions/WindowMenu.hs           |  2 +-
 XMonad/Actions/WindowNavigation.hs     | 18 +++++++++---------
 XMonad/Actions/WithAll.hs              |  2 +-
 35 files changed, 107 insertions(+), 107 deletions(-)

(limited to 'XMonad/Actions')

diff --git a/XMonad/Actions/Commands.hs b/XMonad/Actions/Commands.hs
index 21a48f6..100aab7 100644
--- a/XMonad/Actions/Commands.hs
+++ b/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:
 --
diff --git a/XMonad/Actions/ConstrainedResize.hs b/XMonad/Actions/ConstrainedResize.hs
index 019a29b..b5416a8 100644
--- a/XMonad/Actions/ConstrainedResize.hs
+++ b/XMonad/Actions/ConstrainedResize.hs
@@ -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
diff --git a/XMonad/Actions/CopyWindow.hs b/XMonad/Actions/CopyWindow.hs
index e50e833..f30de69 100644
--- a/XMonad/Actions/CopyWindow.hs
+++ b/XMonad/Actions/CopyWindow.hs
@@ -43,7 +43,7 @@ import qualified XMonad.StackSet as W
 -- > -- 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)]]
 --
@@ -55,12 +55,12 @@ import qualified XMonad.StackSet as W
 -- 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:
 --
--- >  , ((modMask x, xK_b    ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox
+-- >  , ((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
@@ -70,8 +70,8 @@ import qualified XMonad.StackSet as W
 --
 -- 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".
diff --git a/XMonad/Actions/CycleRecentWS.hs b/XMonad/Actions/CycleRecentWS.hs
index 19ff548..95986ad 100644
--- a/XMonad/Actions/CycleRecentWS.hs
+++ b/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".
diff --git a/XMonad/Actions/CycleSelectedLayouts.hs b/XMonad/Actions/CycleSelectedLayouts.hs
index e10f930..1a2d526 100644
--- a/XMonad/Actions/CycleSelectedLayouts.hs
+++ b/XMonad/Actions/CycleSelectedLayouts.hs
@@ -30,7 +30,7 @@ import qualified XMonad.StackSet as S
 -- > 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.
diff --git a/XMonad/Actions/CycleWS.hs b/XMonad/Actions/CycleWS.hs
index f7c9fe4..18be5d8 100644
--- a/XMonad/Actions/CycleWS.hs
+++ b/XMonad/Actions/CycleWS.hs
@@ -90,26 +90,26 @@ 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!
+-- >   , ((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                                         )
 --
diff --git a/XMonad/Actions/CycleWindows.hs b/XMonad/Actions/CycleWindows.hs
index 143cfce..1a21957 100644
--- a/XMonad/Actions/CycleWindows.hs
+++ b/XMonad/Actions/CycleWindows.hs
@@ -64,11 +64,11 @@ import Control.Arrow (second)
 -- >
 -- >              -- make sure mod matches keysym
 -- >  , ((mod4Mask,  xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w)
--- >  , ((modMask x, xK_z), rotOpposite)
--- >  , ((modMask x                , xK_i), rotUnfocusedUp)
--- >  , ((modMask x                , xK_u), rotUnfocusedDown)
--- >  , ((modMask x .|. controlMask, xK_i), rotFocusedUp)
--- >  , ((modMask x .|. controlMask, xK_u), rotFocusedDown)
+-- >  , ((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
@@ -88,9 +88,9 @@ to the point of your choice on the current window:
 and either
 
 > -- modify the window rotation bindings
-> , ((modMask x .|. controlMask, xK_i   ), rotFocusedUp
+> , ((modm .|. controlMask, xK_i   ), rotFocusedUp
 >                                            >> updatePointer (Relative 1 1))
-> , ((modMask x .|. controlMask, xK_u   ), rotFocusedDown
+> , ((modm .|. controlMask, xK_u   ), rotFocusedDown
 >                                            >> updatePointer (Relative 1 1))
 >
 >    -- or add to xmonad's logHook
diff --git a/XMonad/Actions/DeManage.hs b/XMonad/Actions/DeManage.hs
index 9bcc18e..da891df 100644
--- a/XMonad/Actions/DeManage.hs
+++ b/XMonad/Actions/DeManage.hs
@@ -44,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".
diff --git a/XMonad/Actions/DwmPromote.hs b/XMonad/Actions/DwmPromote.hs
index feabb6a..8b20832 100644
--- a/XMonad/Actions/DwmPromote.hs
+++ b/XMonad/Actions/DwmPromote.hs
@@ -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".
diff --git a/XMonad/Actions/DynamicWorkspaces.hs b/XMonad/Actions/DynamicWorkspaces.hs
index 0ce1479..66d4767 100644
--- a/XMonad/Actions/DynamicWorkspaces.hs
+++ b/XMonad/Actions/DynamicWorkspaces.hs
@@ -36,18 +36,18 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 --
 -- 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".
diff --git a/XMonad/Actions/FindEmptyWorkspace.hs b/XMonad/Actions/FindEmptyWorkspace.hs
index 0b03e40..b65faab 100644
--- a/XMonad/Actions/FindEmptyWorkspace.hs
+++ b/XMonad/Actions/FindEmptyWorkspace.hs
@@ -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.
diff --git a/XMonad/Actions/FlexibleManipulate.hs b/XMonad/Actions/FlexibleManipulate.hs
index d7b3621..6ec3739 100644
--- a/XMonad/Actions/FlexibleManipulate.hs
+++ b/XMonad/Actions/FlexibleManipulate.hs
@@ -31,7 +31,7 @@ import XMonad
 --
 -- Now set up the desired mouse binding, for example:
 --
--- >     , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
+-- >     , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
 --
 -- * Flex.'linear' indicates that positions between the edges and the
 --   middle indicate a combination scale\/position.
diff --git a/XMonad/Actions/FlexibleResize.hs b/XMonad/Actions/FlexibleResize.hs
index 380f70e..a387c19 100644
--- a/XMonad/Actions/FlexibleResize.hs
+++ b/XMonad/Actions/FlexibleResize.hs
@@ -29,7 +29,7 @@ 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".
diff --git a/XMonad/Actions/FloatKeys.hs b/XMonad/Actions/FloatKeys.hs
index 6f30cb0..12cbb41 100644
--- a/XMonad/Actions/FloatKeys.hs
+++ b/XMonad/Actions/FloatKeys.hs
@@ -28,11 +28,11 @@ import XMonad
 --
 -- Then add appropriate key bindings, for example:
 --
--- >  , ((modMask x,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
--- >  , ((modMask x,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
--- >  , ((modMask x .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
--- >  , ((modMask x .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
--- >  , ((modMask x,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
+-- >  , ((modm,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
+-- >  , ((modm,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
+-- >  , ((modm .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
+-- >  , ((modm .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
+-- >  , ((modm,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs
index 357162d..3597254 100644
--- a/XMonad/Actions/FloatSnap.hs
+++ b/XMonad/Actions/FloatSnap.hs
@@ -41,23 +41,23 @@ import qualified Data.Set as S
 --
 -- Then add appropriate key bindings, for example:
 --
--- >        , ((modMask x,               xK_Left),  withFocused $ snapMove L Nothing)
--- >        , ((modMask x,               xK_Right), withFocused $ snapMove R Nothing)
--- >        , ((modMask x,               xK_Up),    withFocused $ snapMove U Nothing)
--- >        , ((modMask x,               xK_Down),  withFocused $ snapMove D Nothing)
--- >        , ((modMask x .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
--- >        , ((modMask x .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
--- >        , ((modMask x .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
--- >        , ((modMask x .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
+-- >        , ((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:
 --
--- >        , ((modMask x,               button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
--- >        , ((modMask x .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
--- >        , ((modMask x,               button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
+-- >        , ((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".
diff --git a/XMonad/Actions/FocusNth.hs b/XMonad/Actions/FocusNth.hs
index 725a0db..b02df9b 100644
--- a/XMonad/Actions/FocusNth.hs
+++ b/XMonad/Actions/FocusNth.hs
@@ -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
diff --git a/XMonad/Actions/GridSelect.hs b/XMonad/Actions/GridSelect.hs
index 989e453..4d069ba 100644
--- a/XMonad/Actions/GridSelect.hs
+++ b/XMonad/Actions/GridSelect.hs
@@ -76,13 +76,13 @@ import Data.Word (Word8)
 --
 -- Then add a keybinding, e.g.
 --
--- >    , ((modMask x, xK_g), goToSelected defaultGSConfig)
+-- >    , ((modm, xK_g), goToSelected defaultGSConfig)
 --
 -- This module also supports displaying arbitrary information in a grid and letting
 -- the user select from it. E.g. to spawn an application from a given list, you
 -- can use the following:
 --
--- >   , ((modMask x, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
+-- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
 
 -- $commonGSConfig
 --
@@ -112,8 +112,8 @@ import Data.Word (Word8)
 --
 -- Then you can bind to:
 --
--- >     ,((modMask x, xK_g), goToSelected  $ gsconfig2 myWinColorizer)
--- >     ,((modMask x, xK_p), spawnSelected $ spawnSelected defaultColorizer)
+-- >     ,((modm, xK_g), goToSelected  $ gsconfig2 myWinColorizer)
+-- >     ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)
 
 -- $keybindings
 --
diff --git a/XMonad/Actions/MouseGestures.hs b/XMonad/Actions/MouseGestures.hs
index 49a7582..8c56afb 100644
--- a/XMonad/Actions/MouseGestures.hs
+++ b/XMonad/Actions/MouseGestures.hs
@@ -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:
diff --git a/XMonad/Actions/NoBorders.hs b/XMonad/Actions/NoBorders.hs
index 6d416ed..5aa2fa2 100644
--- a/XMonad/Actions/NoBorders.hs
+++ b/XMonad/Actions/NoBorders.hs
@@ -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
diff --git a/XMonad/Actions/OnScreen.hs b/XMonad/Actions/OnScreen.hs
index 783f124..384ec19 100644
--- a/XMonad/Actions/OnScreen.hs
+++ b/XMonad/Actions/OnScreen.hs
@@ -39,7 +39,7 @@ import Data.Function(on)
 -- to switch the workspaces with this at the bottom of your keybindings:
 --
 -- >     ++
--- >     [ ((m .|. modMask, k), windows (f i))
+-- >     [ ((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)
@@ -60,7 +60,7 @@ import Data.Function(on)
 --
 -- A more basic version inside the default keybindings would be:
 --
--- >        , ((modMask .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))
+-- >        , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))
 --
 -- where 0 is the first screen and "1" the workspace with the tag "1".
 --
diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs
index 7fb4dc8..8e2919c 100644
--- a/XMonad/Actions/PhysicalScreens.hs
+++ b/XMonad/Actions/PhysicalScreens.hs
@@ -48,7 +48,7 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 > -- 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
 > --
-> [((modMask .|. mask, key), f sc)
+> [((modm .|. mask, key), f sc)
 >     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
 >     , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]
 
diff --git a/XMonad/Actions/Promote.hs b/XMonad/Actions/Promote.hs
index 0d270d3..fef21d5 100644
--- a/XMonad/Actions/Promote.hs
+++ b/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".
diff --git a/XMonad/Actions/RotSlaves.hs b/XMonad/Actions/RotSlaves.hs
index ae82a62..f80a1a0 100644
--- a/XMonad/Actions/RotSlaves.hs
+++ b/XMonad/Actions/RotSlaves.hs
@@ -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
diff --git a/XMonad/Actions/SimpleDate.hs b/XMonad/Actions/SimpleDate.hs
index 3b976bb..87dc41e 100644
--- a/XMonad/Actions/SimpleDate.hs
+++ b/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@.
 --
diff --git a/XMonad/Actions/SinkAll.hs b/XMonad/Actions/SinkAll.hs
index cea8960..0fe463b 100644
--- a/XMonad/Actions/SinkAll.hs
+++ b/XMonad/Actions/SinkAll.hs
@@ -28,7 +28,7 @@ import XMonad.Actions.WithAll (sinkAll)
 --
 -- 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".
diff --git a/XMonad/Actions/Submap.hs b/XMonad/Actions/Submap.hs
index a4e2cd9..6788326 100644
--- a/XMonad/Actions/Submap.hs
+++ b/XMonad/Actions/Submap.hs
@@ -34,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")
diff --git a/XMonad/Actions/SwapWorkspaces.hs b/XMonad/Actions/SwapWorkspaces.hs
index 895e7f8..67cf425 100644
--- a/XMonad/Actions/SwapWorkspaces.hs
+++ b/XMonad/Actions/SwapWorkspaces.hs
@@ -37,7 +37,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
diff --git a/XMonad/Actions/TagWindows.hs b/XMonad/Actions/TagWindows.hs
index 4eac8ee..fc89bd8 100644
--- a/XMonad/Actions/TagWindows.hs
+++ b/XMonad/Actions/TagWindows.hs
@@ -42,15 +42,15 @@ 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  ), withTaggedGlobalP "abc" W.sink)
--- >   , ((modMask x,                 xK_d  ), withTaggedP "abc" (W.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))
+-- >   , ((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))
diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs
index c82869a..be5af3e 100644
--- a/XMonad/Actions/TopicSpace.hs
+++ b/XMonad/Actions/TopicSpace.hs
@@ -136,15 +136,15 @@ import XMonad.Util.StringProp(getStringListProp,setStringListProp)
 --
 -- @
 --  -- extend your keybindings
---  myKeys =
---    [ ((modMask              , xK_n     ), spawnShell) -- %! Launch terminal
---    , ((modMask              , xK_a     ), currentTopicAction myTopicConfig)
---    , ((modMask              , xK_g     ), promptedGoto)
---    , ((modMask .|. shiftMask, xK_g     ), promptedShift)
+--  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)
 --    ...
 --    ]
 --    ++
---    [ ((modMask, k), switchNthLastFocused myTopicConfig i)
+--    [ ((modm, k), switchNthLastFocused myTopicConfig i)
 --    | (i, k) <- zip [1..] workspaceKeys]
 -- @
 --
diff --git a/XMonad/Actions/Warp.hs b/XMonad/Actions/Warp.hs
index 863d0f6..4c5faf3 100644
--- a/XMonad/Actions/Warp.hs
+++ b/XMonad/Actions/Warp.hs
@@ -34,11 +34,11 @@ You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 
 then add appropriate keybindings to warp the pointer; for example:
 
-> , ((modMask x,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+> , ((modm,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
 >
 >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
 >
->   [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+>   [((modm .|. controlMask, key), warpToScreen sc (1%2) (1%2))
 >       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
 
 Note that warping to a particular screen may change the focus.
diff --git a/XMonad/Actions/WindowBringer.hs b/XMonad/Actions/WindowBringer.hs
index 2f24dad..eeca913 100644
--- a/XMonad/Actions/WindowBringer.hs
+++ b/XMonad/Actions/WindowBringer.hs
@@ -38,8 +38,8 @@ import XMonad.Util.NamedWindows (getName)
 --
 -- and define appropriate key bindings:
 --
--- > , ((modMask x .|. shiftMask, xK_g     ), gotoMenu)
--- > , ((modMask x .|. shiftMask, xK_b     ), bringMenu)
+-- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
+-- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
diff --git a/XMonad/Actions/WindowGo.hs b/XMonad/Actions/WindowGo.hs
index c1506ab..034b9e5 100644
--- a/XMonad/Actions/WindowGo.hs
+++ b/XMonad/Actions/WindowGo.hs
@@ -53,8 +53,8 @@ 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
diff --git a/XMonad/Actions/WindowMenu.hs b/XMonad/Actions/WindowMenu.hs
index 9d30823..4078703 100644
--- a/XMonad/Actions/WindowMenu.hs
+++ b/XMonad/Actions/WindowMenu.hs
@@ -39,7 +39,7 @@ import XMonad.Util.XUtils (fi)
 --
 -- Then add a keybinding, e.g.
 --
--- >    , ((modMask x,               xK_o ), windowMenu)
+-- >    , ((modm,               xK_o ), windowMenu)
 
 windowMenu :: X ()
 windowMenu = withFocused $ \w -> do
diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs
index a4769eb..6b721ec 100644
--- a/XMonad/Actions/WindowNavigation.hs
+++ b/XMonad/Actions/WindowNavigation.hs
@@ -86,15 +86,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)
diff --git a/XMonad/Actions/WithAll.hs b/XMonad/Actions/WithAll.hs
index f882644..ffd046a 100644
--- a/XMonad/Actions/WithAll.hs
+++ b/XMonad/Actions/WithAll.hs
@@ -30,7 +30,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".
-- 
cgit v1.2.3