bump cabal-version to satsify hackage

The warnings were related to ghc-7.6 removing Prelude.catch
(triggering warnings regarding the import hiding it), as well
as defaulting of some numeric types.

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

@@ -26,7 +26,6 @@ module XMonad.Actions.CopyWindow (
 
 import XMonad
 import Control.Arrow ((&&&))
-import Control.Monad
 import qualified Data.List as L
 
 import XMonad.Actions.WindowGo
@@ -146,7 +145,9 @@ killAllOtherCopies = do ss <- gets windowset
       delFromAllButCurrent w ss = foldr ($) ss $
                                   map (delWinFromWorkspace w . W.tag) $
                                   W.hidden ss ++ map W.workspace (W.visible ss)
-      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid
+      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]

XMonad/Actions/CycleWS.hs

@@ -46,6 +46,7 @@ module XMonad.Actions.CycleWS (
                                 -- * Toggling the previous workspace
                                 -- $toggling
                               , toggleWS
+                              , toggleWS'
                               , toggleOrView
 
                                 -- * Moving between screens (xinerama)
@@ -65,6 +66,7 @@ module XMonad.Actions.CycleWS (
 
                               , shiftTo
                               , moveTo
+                              , doTo
 
                                 -- * The mother-combinator
 
@@ -72,6 +74,8 @@ module XMonad.Actions.CycleWS (
                               , toggleOrDoSkip
                               , skipTags
 
+                              , screenBy
+
                              ) where
 
 import Control.Monad ( unless )
@@ -147,9 +151,16 @@ shiftToPrev = shiftBy (-1)
 
 -- | Toggle to the workspace displayed previously.
 toggleWS :: X ()
-toggleWS = do
-    hs <- gets (hidden . windowset)
-    unless (null hs) (windows . view . tag $ head hs)
+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
@@ -159,9 +170,8 @@ toggleWS = do
 toggleOrView :: WorkspaceId -> X ()
 toggleOrView = toggleOrDoSkip [] greedyView
 
--- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while
--- finding the previously displayed workspace, or choice of different actions,
--- like view, shift, etc.  For example:
+-- | 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
@@ -174,9 +184,9 @@ toggleOrView = toggleOrDoSkip [] greedyView
 toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
                                   -> WorkspaceId -> X ()
 toggleOrDoSkip skips f toWS = do
-    ws <- gets windowset
-    let hs' = hidden ws `skipTags` skips
-    if toWS == (tag . workspace $ current ws)
+    hs' <- cleanHiddens skips
+    cur <- gets (currentTag . windowset)
+    if toWS == cur
         then unless (null hs') (windows . f . tag $ head hs')
         else windows (f toWS)
 
@@ -185,6 +195,9 @@ toggleOrDoSkip skips f toWS = do
 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
 
@@ -218,6 +231,10 @@ data WSType = EmptyWS     -- ^ cycle through empty workspaces
             | HiddenWS    -- ^ cycle through non-visible workspaces
             | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces
             | AnyWS       -- ^ cycle through all workspaces
+            | WSTagGroup Char
+                          -- ^ cycle through workspaces in the same group, the
+                          --   group name is all characters up to the first
+                          --   separator character or the end of the tag
             | WSIs (X (WindowSpace -> Bool))
                           -- ^ cycle through workspaces satisfying
                           --   an arbitrary predicate
@@ -232,17 +249,25 @@ wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS
                                     hi <- wsTypeToPred HiddenWS
                                     return (\w -> hi w && ne w)
 wsTypeToPred AnyWS      = return (const True)
+wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
+                                   return $ (cur ==).groupName
+                                   where groupName = takeWhile (/=sep).tag
 wsTypeToPred (WSIs p)   = p
 
 -- | View the next workspace in the given direction that satisfies
 --   the given condition.
 moveTo :: Direction1D -> WSType -> X ()
-moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
+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 :: Direction1D -> WSType -> X ()
-shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
+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
@@ -300,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

@@ -226,8 +226,10 @@ rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwis
            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
 
 -- $generic
--- Generic list rotations
+-- 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 = tail l ++ [head l]
+rotUp   l = drop 1 l ++ take 1 l
 rotDown :: [a] -> [a]
-rotDown l = last l : init l
+rotDown = reverse . rotUp . reverse

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,178 @@
+{-# 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
+
+    , withNthWorkspace
+
+    ) 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)
+
+-- | Do something with the nth workspace in the dynamic order.  The
+--   callback is given the workspace's tag as well as the 'WindowSet'
+--   of the workspace itself.
+withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
+withNthWorkspace job wnum = do
+  sort <- getSortByOrder
+  ws <- gets (map W.tag . sort . W.workspaces . windowset)
+  case drop wnum ws of
+    (w:_) -> windows $ job w
+    []    -> return ()

XMonad/Actions/DynamicWorkspaces.hs

@@ -8,31 +8,39 @@
 -- 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,
+                                         renameWorkspaceByName,
                                          toNthWorkspace, withNthWorkspace
                                        ) where
 
 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:
 --
@@ -50,14 +58,10 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 -- >    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
 
@@ -70,11 +74,13 @@ withWorkspace c job = do ws <- gets (workspaces . windowset)
                          mkXPrompt (Wor "") c (mkCompl ts) job'
 
 renameWorkspace :: XPConfig -> X ()
-renameWorkspace conf = workspacePrompt conf $ \w ->
-                       windows $ \s -> let sett wk = wk { tag = w }
-                                           setscr scr = scr { workspace = sett $ workspace scr }
-                                           sets q = q { current = setscr $ current q }
-                                       in sets $ removeWorkspace' w s
+renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
+
+renameWorkspaceByName :: String -> X ()
+renameWorkspaceByName w = windows $ \s -> let sett wk = wk { tag = w }
+                                              setscr scr = scr { workspace = sett $ workspace scr }
+                                              sets q = q { current = setscr $ current q }
+                                          in sets $ removeWorkspace' w s
 
 toNthWorkspace :: (String -> X ()) -> Int -> X ()
 toNthWorkspace job wnum = do sort <- getSortByIndex
@@ -97,25 +103,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

@@ -15,7 +15,7 @@
 module XMonad.Actions.FindEmptyWorkspace (
     -- * Usage
     -- $usage
-    viewEmptyWorkspace, tagToEmptyWorkspace
+    viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
   ) where
 
 import Data.List
@@ -65,3 +65,8 @@ viewEmptyWorkspace = withEmptyWorkspace (windows . view)
 -- all workspaces are in use.
 tagToEmptyWorkspace :: X ()
 tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w
+
+-- | Send current window to an empty workspace. Do nothing if
+-- all workspaces are in use.
+sendToEmptyWorkspace :: X ()
+sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w

XMonad/Actions/FlexibleManipulate.hs

@@ -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@:
@@ -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

@@ -20,6 +20,7 @@ module XMonad.Actions.FlexibleResize (
 ) where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Foreign.C.Types
 
 -- $usage
@@ -76,6 +77,3 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
                       Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
                       Nothing ->    (k `div` 2, const p, const $ fi k)
                       Just False -> (k, const p, subtract (fi p) . fi)
-
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral

XMonad/Actions/FloatKeys.hs

@@ -17,7 +17,9 @@ module XMonad.Actions.FloatKeys (
                 keysMoveWindow,
                 keysMoveWindowTo,
                 keysResizeWindow,
-                keysAbsResizeWindow) where
+                keysAbsResizeWindow,
+                P, G,
+                ) where
 
 import XMonad
 

XMonad/Actions/GridSelect.hs

@@ -28,7 +28,6 @@ module XMonad.Actions.GridSelect (
     -- * Configuration
     GSConfig(..),
     defaultGSConfig,
-    NavigateMap,
     TwoDPosition,
     buildDefaultGSConfig,
 
@@ -38,6 +37,7 @@ module XMonad.Actions.GridSelect (
     withSelectedWindow,
     bringSelected,
     goToSelected,
+    gridselectWorkspace,
     spawnSelected,
     runSelectedAction,
 
@@ -45,13 +45,36 @@ module XMonad.Actions.GridSelect (
     HasColorizer(defaultColorizer),
     fromClassName,
     stringColorizer,
-    colorRangeFromClassName
+    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 Data.Ord (comparing)
 import Control.Applicative
 import Control.Monad.State
 import Control.Arrow
@@ -92,13 +115,13 @@ import Data.Word (Word8)
 -- > {-# LANGUAGE NoMonomorphismRestriction #-}
 -- > import XMonad
 -- > ...
--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellWidth = 100 }
+-- > 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 }
+-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 }
 --
 -- > -- | A green monochrome colorizer based on window class
 -- > greenColorizer = colorRangeFromClassName
@@ -117,45 +140,48 @@ import Data.Word (Word8)
 
 -- $keybindings
 --
--- Adding more keybindings for gridselect to listen to is similar:
+-- You can build you own navigation mode and submodes by combining the
+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
 --
--- At the top of your config:
+-- > 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
 --
--- > {-# LANGAUGE NoMonomorphismRestriction #-}
--- > import XMonad
--- > import qualified Data.Map as M
---
--- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
+-- 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 = M.unions
--- >            [reset
--- >            ,nethackKeys
--- >            ,gs_navigate                               -- get the default navigation bindings
--- >                $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable
--- >            ]
+-- >    , gs_navigate = myNavigation
 -- >    }
--- >   where addPair (a,b) (x,y) = (a+x,b+y)
--- >         nethackKeys = M.map addPair $ M.fromList
--- >                               [((0,xK_y),(-1,-1))
--- >                               ,((0,xK_i),(1,-1))
--- >                               ,((0,xK_n),(-1,1))
--- >                               ,((0,xK_m),(1,1))
--- >                               ]
--- >         -- jump back to the center with the spacebar, regardless of the current position.
--- >         reset = M.singleton (0,xK_space) (const (0,0))
 
 -- $screenshots
 --
 -- Selecting a workspace:
 --
--- <<http://haskell.org/sitewiki/images/a/a9/Xmonad-gridselect-workspace.png>>
+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
 --
 -- Selecting a window by title:
 --
--- <<http://haskell.org/sitewiki/images/3/35/Xmonad-gridselect-window-aavogt.png>>
+-- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>
 
 data GSConfig a = GSConfig {
       gs_cellheight :: Integer,
@@ -163,7 +189,7 @@ data GSConfig a = GSConfig {
       gs_cellpadding :: Integer,
       gs_colorizer :: a -> Bool -> X (String, String),
       gs_font :: String,
-      gs_navigate :: NavigateMap,
+      gs_navigate :: TwoD a (Maybe a),
       gs_originFractX :: Double,
       gs_originFractY :: Double
 }
@@ -193,21 +219,56 @@ instance HasColorizer a where
 defaultGSConfig :: HasColorizer a => GSConfig a
 defaultGSConfig = buildDefaultGSConfig defaultColorizer
 
-type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)
-
 type TwoDPosition = (Integer, Integer)
 
 type TwoDElementMap a = [(TwoDPosition,(String,a))]
 
 data TwoDState a = TwoDState { td_curpos :: TwoDPosition
-                             , td_elementmap :: TwoDElementMap a
+                             , td_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 = zipWith (,) positions sortedElements
+  where
+    TwoDState {td_availSlots = positions,
+               td_searchString = searchString} = s
+    -- Filter out any elements that don't contain the searchString (case insensitive)
+    filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s)
+    -- Sorts the elementmap
+    sortedElements = orderElementmap searchString filteredElements
+    -- Case Insensitive version of isInfixOf
+    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
+    upper = map toUpper
+
+
+-- | We enforce an ordering such that we will always get the same result. If the
+-- elements position changes from call to call of gridselect, then the shown
+-- positions will also change when you search for the same string. This is
+-- especially the case when using gridselect for showing and switching between
+-- workspaces, as workspaces are usually shown in order of last visited.  The
+-- chosen ordering is "how deep in the haystack the needle is" (number of
+-- characters from the beginning of the string and the needle).
+orderElementmap :: String  -> [(String,a)] -> [(String,a)]
+orderElementmap searchString elements = if not $ null searchString then sortedElements else elements
+  where
+    upper = map toUpper
+    -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.
+    calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element)
+                        , element)
+    -- Use the score and then the string as the parameters for comparing, making
+    -- it consistent even when two strings that score the same, as it will then be
+    -- sorted by the strings, making it consistent.
+    compareScore = comparing (\(score, (str,_)) -> (score, str))
+    sortedElements = map snd . sortBy compareScore $ map calcScore elements
+
+
 newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
     deriving (Monad,Functor,MonadState (TwoDState a))
 
@@ -221,14 +282,16 @@ liftX = TwoD . lift
 evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
 evalTwoD m s = flip evalStateT s $ unTwoD m
 
-diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
--- FIXME remove nub
-diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
-        in nub $ ul ++ (map (negate *** id) ul) ++
-           (map (negate *** negate) ul) ++
-           (map (id *** negate) ul)
+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) => [(a, a)]
+diamond :: (Enum a, Num a, Eq a) => [(a, a)]
 diamond = concatMap diamondLayer [0..]
 
 diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
@@ -237,9 +300,6 @@ diamondRestrict x y originX originY =
   map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
   take 1000 $ diamond
 
-tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)
-tupadd (a,b) (c,d) = (a+c,b+d)
-
 findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
 findInElementMap pos = find ((== pos) . fst)
 
@@ -268,11 +328,23 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
 updateAllElements :: TwoD a ()
 updateAllElements =
     do
-      TwoDState { td_elementmap = els } <- get
-      updateElements els
+      s <- get
+      updateElements (td_elementmap s)
+
+grayoutAllElements :: TwoD a ()
+grayoutAllElements =
+    do
+      s <- get
+      updateElementsWithColorizer grayOnly (td_elementmap s)
+    where grayOnly _ _ = return ("#808080", "#808080")
 
 updateElements :: TwoDElementMap a -> TwoD a ()
 updateElements elementmap = do
+      s <- get
+      updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap
+
+updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
+updateElementsWithColorizer colorizer elementmap = do
     TwoDState { td_curpos = curpos,
                 td_drawingWin = win,
                 td_gsconfig = gsconfig,
@@ -284,7 +356,7 @@ updateElements elementmap = do
         paneX' = div (paneX-cellwidth) 2
         paneY' = div (paneY-cellheight) 2
         updateElement (pos@(x,y),(text, element)) = liftX $ do
-            colors <- gs_colorizer gsconfig element (pos == curpos)
+            colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
                        cellheight
@@ -295,52 +367,180 @@ updateElements elementmap = do
                        (gs_cellpadding gsconfig)
     mapM_ updateElement elementmap
 
-eventLoop :: TwoD a (Maybe a)
-eventLoop = do
-  (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
-                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
-                             ev <- getEvent e
-                             (ks,s) <- if ev_event_type ev == keyPress
-                                       then lookupString $ asKeyEvent e
-                                       else return (Nothing, "")
-                             return (ks,s,ev)
-  handle (fromMaybe xK_VoidSymbol keysym,string) event
-
-handle ::  (KeySym, t) -> Event -> TwoD a (Maybe a)
-handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })
-    | t == keyPress && ks == xK_Escape = return Nothing
-    | t == keyPress && ks == xK_Return = do
-       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get
-       return $ fmap (snd . snd) $ findInElementMap pos elmap
-    | t == keyPress = do
-        m' <- liftX (cleanMask m)
-        keymap <- gets (gs_navigate . td_gsconfig)
-        maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap
-  where diffAndRefresh diff = do
-          state <- get
-          let elmap = td_elementmap state
-              oldPos = td_curpos state
-              newPos = diff oldPos
-              newSelectedEl = findInElementMap newPos elmap
-          when (isJust newSelectedEl) $ do
-                                put state { td_curpos =  newPos }
-                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
-          eventLoop
-
-handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })
+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
-        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,
-                     td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get
+        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) elmap of
+        case lookup (gridX,gridY) (td_elementmap s) of
              Just (_,el) -> return (Just el)
-             Nothing -> eventLoop
-    | otherwise = eventLoop
+             Nothing -> contEventloop
+    | otherwise = contEventloop
 
-handle _ (ExposeEvent { }) = updateAllElements >> eventLoop
+stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
+
+stdHandle _ contEventloop = contEventloop
+
+-- | Embeds a key handler into the X event handler that dispatches key
+-- events to the key handler, while non-key event go to the standard
+-- handler.
+makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
+makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+                             ev <- getEvent e
+                             if ev_event_type ev == keyPress
+                               then do
+                                  (ks,s) <- lookupString $ asKeyEvent e
+                                  return $ do
+                                      mask <- liftX $ cleanMask (ev_state ev)
+                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)
+                               else
+                                  return $ stdHandle ev me
+
+-- | When the map contains (KeySym,KeyMask) tuple for the given event,
+-- the associated action in the map associated shadows the default key
+-- handler
+shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
+shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap)
+
+-- Helper functions to use for key handler functions
+
+-- | Closes gridselect returning the element under the cursor
+select :: TwoD a (Maybe a)
+select = do
+  s <- get
+  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+
+-- | Closes gridselect returning no element.
+cancel :: TwoD a (Maybe a)
+cancel = return Nothing
+
+-- | Sets the absolute position of the cursor.
+setPos :: (Integer, Integer) -> TwoD a ()
+setPos newPos = do
+  s <- get
+  let elmap = td_elementmap s
+      newSelectedEl = findInElementMap newPos (td_elementmap s)
+      oldPos = td_curpos s
+  when (isJust newSelectedEl && newPos /= oldPos) $ do
+    put s { td_curpos = newPos }
+    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+
+-- | Moves the cursor by the offsets specified
+move :: (Integer, Integer) -> TwoD a ()
+move (dx,dy) = do
+  s <- get
+  let (x,y) = td_curpos s
+      newPos = (x+dx,y+dy)
+  setPos newPos
+
+moveNext :: TwoD a ()
+moveNext = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just k | k == n-1 -> Just 0
+                      | otherwise -> Just (k+1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+movePrev :: TwoD a ()
+movePrev = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just 0  -> Just (n-1)
+               Just k  -> Just (k-1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+-- | Apply a transformation function the current search string
+transformSearchString :: (String -> String) -> TwoD a ()
+transformSearchString f = do
+          s <- get
+          let oldSearchString = td_searchString s
+              newSearchString = f oldSearchString
+          when (newSearchString /= oldSearchString) $ do
+            -- FIXME: grayoutAllElements + updateAllElements paint some fields twice causing flickering
+            --        we would need a much smarter update strategy to fix that
+            when (length newSearchString > length oldSearchString) grayoutAllElements
+            -- FIXME curpos might end up outside new bounds
+            put s { td_searchString = newSearchString }
+            updateAllElements
+
+-- | By default gridselect used the defaultNavigation action, which
+-- binds left,right,up,down and vi-style h,l,j,k navigation. Return
+-- quits gridselect, returning the selected element, while Escape
+-- cancels the selection. Slash enters the substring search mode. In
+-- substring search mode, every string-associated keystroke is
+-- added to a search string, which narrows down the object
+-- selection. Substring search mode comes back to regular navigation
+-- via Return, while Escape cancels the search. If you want that
+-- navigation style, add 'defaultNavigation' as 'gs_navigate' to your
+-- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.
+defaultNavigation :: TwoD a (Maybe a)
+defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+  where navKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_slash)      , substringSearch defaultNavigation)
+          ,((0,xK_Left)       , move (-1,0) >> defaultNavigation)
+          ,((0,xK_h)          , move (-1,0) >> defaultNavigation)
+          ,((0,xK_Right)      , move (1,0) >> defaultNavigation)
+          ,((0,xK_l)          , move (1,0) >> defaultNavigation)
+          ,((0,xK_Down)       , move (0,1) >> defaultNavigation)
+          ,((0,xK_j)          , move (0,1) >> defaultNavigation)
+          ,((0,xK_Up)         , move (0,-1) >> defaultNavigation)
+          ,((0,xK_k)          , move (0,-1) >> defaultNavigation)
+          ,((0,xK_Tab)        , moveNext >> defaultNavigation)
+          ,((0,xK_n)          , moveNext >> defaultNavigation)
+          ,((shiftMask,xK_Tab), movePrev >> defaultNavigation)
+          ,((0,xK_p)          , movePrev >> defaultNavigation)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navDefaultHandler = const defaultNavigation
+
+-- | This navigation style combines navigation and search into one mode at the cost of losing vi style
+-- navigation. With this style, there is no substring search submode,
+-- but every typed character is added to the substring search.
+navNSearch :: TwoD a (Maybe a)
+navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler
+  where navNSearchKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_Left)       , move (-1,0) >> navNSearch)
+          ,((0,xK_Right)      , move (1,0) >> navNSearch)
+          ,((0,xK_Down)       , move (0,1) >> navNSearch)
+          ,((0,xK_Up)         , move (0,-1) >> navNSearch)
+          ,((0,xK_Tab)        , moveNext >> navNSearch)
+          ,((shiftMask,xK_Tab), movePrev >> navNSearch)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navNSearchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          navNSearch
+
+-- | Navigation submode used for substring search. It returns to the
+-- first argument navigation style when the user hits Return.
+substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
+substringSearch returnNavigation = fix $ \me ->
+  let searchKeyMap = M.fromList [
+           ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)
+          ,((0,xK_Return)   , returnNavigation)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
+          ]
+      searchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          me
+  in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler
 
-handle _ _ = eventLoop
 
 -- FIXME probably move that into Utils?
 -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
@@ -418,7 +618,8 @@ stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
 -- | Brings up a 2D grid of elements in the center of the screen, and one can
 -- select an element with cursors keys. The selected element is returned.
 gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
-gridselect gsconfig elmap =
+gridselect _ [] = return Nothing
+gridselect gsconfig elements =
  withDisplay $ \dpy -> do
     rootw <- asks theRoot
     s <- gets $ screenRect . W.screenDetail . W.current . windowset
@@ -438,16 +639,16 @@ gridselect gsconfig elmap =
                                 originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
                                 originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
                                 coords = diamondRestrict restrictX restrictY originPosX originPosY
-                                elmap' = zip coords elmap
 
-                            evalTwoD (updateAllElements >> eventLoop)
-                                (TwoDState (head coords)
-                                            elmap'
-                                            gsconfig
-                                            font
-                                            screenWidth
-                                            screenHeight
-                                            win)
+                            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
@@ -484,19 +685,7 @@ decorateName' w = do
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)
-
-defaultGSNav :: NavigateMap
-defaultGSNav = M.map tupadd $ M.fromList
-    [((0,xK_Left) ,(-1,0))
-    ,((0,xK_h)    ,(-1,0))
-    ,((0,xK_Right),(1,0))
-    ,((0,xK_l)    ,(1,0))
-    ,((0,xK_Down) ,(0,1))
-    ,((0,xK_j)    ,(0,1))
-    ,((0,xK_Up)   ,(0,-1))
-    ,((0,xK_k)    ,(0,-1))
-    ]
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation (1/2) (1/2)
 
 borderColor :: String
 borderColor = "white"
@@ -523,3 +712,15 @@ runSelectedAction conf actions = do
     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/Launcher.hs

@@ -0,0 +1,123 @@
+{- |
+Module      :  XMonad.Actions.Launcher
+Copyright   :  (C) 2012 Carlos López-Camey
+License     :  None; public domain
+
+Maintainer  :  <c.lopez@kmels.net>
+Stability   :  unstable
+
+A set of prompts for XMonad
+-}
+
+module XMonad.Actions.Launcher(
+  -- * Description and use
+  -- $description
+  defaultLauncherModes
+  , ExtensionActions
+  , LauncherConfig(..)
+  , launcherPrompt
+) where
+
+import           Data.List       (find, findIndex, isPrefixOf, tails)
+import qualified Data.Map        as M
+import           Data.Maybe      (isJust)
+import           XMonad          hiding (config)
+import           XMonad.Prompt
+import           XMonad.Util.Run
+
+{- $description
+    This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes:
+
+       * Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock.
+
+       * Calc: Uses the program calc to do calculations.
+
+    To test it, modify your local .xmonad:
+
+    > import XMonad.Prompt(defaultXPConfig)
+    > import XMonad.Actions.Launcher
+
+    > ((modm .|. controlMask, xK_l), launcherPrompt defaultXPConfig $ defaultLauncherModes launcherConfig)
+
+    A LauncherConfig contains settings for the default modes, modify them accordingly.
+
+    > launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"}
+
+Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up.
+
+ If you used 'defaultXPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'.
+ -}
+
+data HoogleMode = HMode FilePath String --path to hoogle and browser
+data CalculatorMode = CalcMode
+
+data LauncherConfig = LauncherConfig {
+  browser        :: String
+  , pathToHoogle :: String
+}
+
+type ExtensionActions = M.Map String (String -> X())
+
+-- | Uses the command `calc` to compute arithmetic expressions
+instance XPrompt CalculatorMode where
+  showXPrompt CalcMode = "calc %s> "
+  commandToComplete CalcMode = id --send the whole string to `calc`
+  completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
+    fmap lines $ runProcessWithInput "calc" [s] ""
+  modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
+
+-- | Uses the program `hoogle` to search for functions
+instance XPrompt HoogleMode where
+  showXPrompt _ = "hoogle %s> "
+  commandToComplete _ = id
+  completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]
+  -- This action calls hoogle again to find the URL corresponding to the autocompleted item
+  modeAction (HMode pathToHoogleBin'' browser') query result = do
+    completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]
+    let link = do
+          s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink
+          i <- findSeqIndex s "http://"
+          return $ drop i s
+    case link of
+       Just l -> spawn $ browser' ++ " " ++ l
+       _      -> return ()
+    where
+      -- | Receives a sublist and a list. It returns the index where the sublist appears in the list.
+      findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int
+      findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs
+
+-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
+completionFunctionWith :: String -> [String] -> IO [String]
+completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""
+
+-- | Creates a prompt with the given modes
+launcherPrompt :: XPConfig -> [XPMode] -> X()
+launcherPrompt config modes = mkXPromptWithModes modes config
+
+-- | Create a list of modes based on :
+-- a list of extensions mapped to actions
+-- the path to hoogle
+defaultLauncherModes :: LauncherConfig -> [XPMode]
+defaultLauncherModes cnf = let
+  ph           = pathToHoogle cnf
+  in [ hoogleMode ph $ browser cnf
+     , calcMode]
+
+hoogleMode :: FilePath -> String -> XPMode
+hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser'
+calcMode :: XPMode
+calcMode = XPT CalcMode
+
+{-
+
+  -- ideas for XMonad.Prompt running on mode XPMultipleModes
+     * Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g)
+
+     * Support for actions of type String -> X a
+
+  -- ideas for this module
+
+     * Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?)
+
+     * Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json)
+-}

XMonad/Actions/MessageFeedback.hs

@@ -1,10 +1,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.MessageFeedback
--- Copyright    : (c) Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright    : (c) Quentin Moser <moserq@gmail.com>
 -- License      : BSD3
 --
--- Maintainer   : None
+-- Maintainer   : orphaned
 -- Stability    : unstable
 -- Portability  : unportable
 --

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
@@ -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/Navigation2D.hs

@@ -0,0 +1,778 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Navigation2D
+-- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Norbert Zeh <nzeh@cs.dal.ca>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Navigation2D is an xmonad extension that allows easy directional
+-- navigation of windows and screens (in a multi-monitor setup).
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Navigation2D ( -- * Usage
+                                     -- $usage
+
+                                     -- * Finer points
+                                     -- $finer_points
+
+                                     -- * Alternative directional navigation modules
+                                     -- $alternatives
+
+                                     -- * Incompatibilities
+                                     -- $incompatibilities
+
+                                     -- * Detailed technical discussion
+                                     -- $technical
+
+                                     -- * Exported functions and types
+                                     -- #Exports#
+
+                                     withNavigation2DConfig
+                                   , Navigation2DConfig(..)
+                                   , defaultNavigation2DConfig
+                                   , Navigation2D
+                                   , lineNavigation
+                                   , centerNavigation
+                                   , fullScreenRect
+                                   , singleWindowRect
+                                   , switchLayer
+                                   , windowGo
+                                   , windowSwap
+                                   , windowToScreen
+                                   , screenGo
+                                   , screenSwap
+                                   , Direction2D(..)
+                                   ) where
+
+import Control.Applicative
+import qualified Data.List as L
+import qualified Data.Map as M
+import Data.Maybe
+import XMonad hiding (Screen)
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Types
+
+-- $usage
+-- #Usage#
+-- Navigation2D provides directional navigation (go left, right, up, down) for
+-- windows and screens.  It treats floating and tiled windows as two separate
+-- layers and provides mechanisms to navigate within each layer and to switch
+-- between layers.  Navigation2D provides two different navigation strategies
+-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
+-- natural but may make it impossible to navigate to a given window from the
+-- current window, particularly in the floating layer.  /Center navigation/
+-- feels less natural in certain situations but ensures that all windows can be
+-- reached without the need to involve the mouse.  Navigation2D allows different
+-- navigation strategies to be used in the two layers and allows customization
+-- of the navigation strategy for the tiled layer based on the layout currently
+-- in effect.
+--
+-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Navigation2D
+--
+-- Then edit your keybindings:
+--
+-- >    -- Switch between layers
+-- >    , ((modm,                 xK_space), switchLayers)
+-- >
+-- >    -- Directional navigation of windows
+-- >    , ((modm,                 xK_Right), windowGo R False)
+-- >    , ((modm,                 xK_Left ), windowGo L False)
+-- >    , ((modm,                 xK_Up   ), windowGo U False)
+-- >    , ((modm,                 xK_Down ), windowGo D False)
+-- >
+-- >    -- Swap adjacent windows
+-- >    , ((modm .|. controlMask, xK_Right), windowSwap R False)
+-- >    , ((modm .|. controlMask, xK_Left ), windowSwap L False)
+-- >    , ((modm .|. controlMask, xK_Up   ), windowSwap U False)
+-- >    , ((modm .|. controlMask, xK_Down ), windowSwap D False)
+-- >
+-- >    -- Directional navigation of screens
+-- >    , ((modm,                 xK_r    ), screenGo R False)
+-- >    , ((modm,                 xK_l    ), screenGo L False)
+-- >    , ((modm,                 xK_u    ), screenGo U False)
+-- >    , ((modm,                 xK_d    ), screenGo D False)
+-- >
+-- >    -- Swap workspaces on adjacent screens
+-- >    , ((modm .|. controlMask, xK_r    ), screenSwap R False)
+-- >    , ((modm .|. controlMask, xK_l    ), screenSwap L False)
+-- >    , ((modm .|. controlMask, xK_u    ), screenSwap U False)
+-- >    , ((modm .|. controlMask, xK_d    ), screenSwap D False)
+-- >
+-- >    -- Send window to adjacent screen
+-- >    , ((modm .|. mod1Mask,    xK_r    ), windowToScreen R False)
+-- >    , ((modm .|. mod1Mask,    xK_l    ), windowToScreen L False)
+-- >    , ((modm .|. mod1Mask,    xK_u    ), windowToScreen U False)
+-- >    , ((modm .|. mod1Mask,    xK_d    ), windowToScreen D False)
+--
+-- and add the configuration of the module to your main function:
+--
+-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig
+-- >               $ defaultConfig
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- $finer_points
+-- #Finer_Points#
+-- The above should get you started.  Here are some finer points:
+--
+-- Navigation2D has the ability to wrap around at screen edges.  For example, if
+-- you navigated to the rightmost window on the rightmost screen and you
+-- continued to go right, this would get you to the leftmost window on the
+-- leftmost screen.  This feature may be useful for switching between screens
+-- that are far apart but may be confusing at least to novice users.  Therefore,
+-- it is disabled in the above example (e.g., navigation beyond the rightmost
+-- window on the rightmost screen is not possible and trying to do so will
+-- simply not do anything.)  If you want this feature, change all the 'False'
+-- values in the above example to 'True'.  You could also decide you want
+-- wrapping only for a subset of the operations and no wrapping for others.
+--
+-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
+-- in the 'Navigation2DConfig' (by default, line navigation is used).  To
+-- override this behaviour for some layouts, add a pair (\"layout name\",
+-- navigation strategy) to the 'layoutNavigation' list in the
+-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
+-- layout's description method (normally what is shown as the layout name in
+-- your status bar).  For example, all navigation strategies normally allow only
+-- navigation between mapped windows.  The first step to overcome this, for
+-- example, for the Full layout, is to switch to center navigation for the Full
+-- layout:
+--
+-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] }
+-- >
+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
+-- >               $ defaultConfig
+--
+-- The navigation between windows is based on their screen rectangles, which are
+-- available /and meaningful/ only for mapped windows.  Thus, as already said,
+-- the default is to allow navigation only between mapped windows.  However,
+-- there are layouts that do not keep all windows mapped.  One example is the
+-- Full layout, which unmaps all windows except the one that has the focus,
+-- thereby preventing navigation to any other window in the layout.  To make
+-- navigation to unmapped windows possible, unmapped windows need to be assigned
+-- rectangles to pretend they are mapped, and a natural way to do this for the
+-- Full layout is to pretend all windows occupy the full screen and are stacked
+-- on top of each other so that only the frontmost one is visible.  This can be
+-- done as follows:
+--
+-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation   = [("Full", centerNavigation)]
+-- >                                                  , unmappedWindowRect = [("Full", singleWindowRect)]
+-- >                                                  }
+-- >
+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
+-- >               $ defaultConfig
+--
+-- With this setup, Left/Up navigation behaves like standard
+-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
+-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
+-- layout.
+--
+-- In general, each entry in the 'unmappedWindowRect' association list is a pair
+-- (\"layout description\", function), where the function computes a rectangle
+-- for each unmapped window from the screen it is on and the window ID.
+-- Currently, Navigation2D provides only two functions of this type:
+-- 'singleWindowRect' and 'fullScreenRect'.
+--
+-- With per-layout navigation strategies, if different layouts are in effect on
+-- different screens in a multi-monitor setup, and different navigation
+-- strategies are defined for these active layouts, the most general of these
+-- navigation strategies is used across all screens (because Navigation2D does
+-- not distinguish between windows on different workspaces), where center
+-- navigation is more general than line navigation, as discussed formally under
+-- <#Technical_Discussion>.
+
+-- $alternatives
+-- #Alternatives#
+--
+-- There exist two alternatives to Navigation2D:
+-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
+-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
+-- window that would receive the focus in each navigation direction, but it does
+-- not support navigation across multiple monitors, does not support directional
+-- navigation of floating windows, and has a very unintuitive definition of
+-- which window receives the focus next in each direction.  X.A.WindowNavigation
+-- does support navigation across multiple monitors but does not provide window
+-- colouring while retaining the unintuitive navigational semantics of
+-- X.L.WindowNavigation.  This makes it very difficult to predict which window
+-- receives the focus next.  Neither X.A.WindowNavigation nor
+-- X.L.WindowNavigation supports directional navigation of screens.
+
+-- $technical
+-- #Technical_Discussion#
+-- An in-depth discussion of the navigational strategies implemented in
+-- Navigation2D, including formal proofs of their properties, can be found
+-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.
+
+-- $incompatibilities
+-- #Incompatibilities#
+-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
+-- it should work well with any other tiled layout.  My hope is to address the
+-- incompatibility with tabbed layouts in a future version.  The navigation to
+-- unmapped windows, for example in a Full layout, by assigning rectangles to
+-- unmapped windows is more a workaround than a clean solution.  Figuring out
+-- how to deal with tabbed layouts may also lead to a more general and cleaner
+-- solution to query the layout for a window's rectangle that may make this
+-- workaround unnecessary.  At that point, the 'unmappedWindowRect' field of the
+-- 'Navigation2DConfig' will disappear.
+
+-- | A rectangle paired with an object
+type Rect a = (a, Rectangle)
+
+-- | A shorthand for window-rectangle pairs.  Reduces typing.
+type WinRect = Rect Window
+
+-- | A shorthand for workspace-rectangle pairs.  Reduces typing.
+type WSRect = Rect WorkspaceId
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                        PUBLIC INTERFACE                                        --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Encapsulates the navigation strategy
+data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
+
+runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
+runNav (N _ nav) = nav
+
+-- | Score that indicates how general a navigation strategy is
+type Generality = Int
+
+instance Eq Navigation2D where
+  (N x _) == (N y _) = x == y
+
+instance Ord Navigation2D where
+  (N x _) <= (N y _) = x <= y
+
+-- | Line navigation.  To illustrate this navigation strategy, consider
+-- navigating to the left from the current window.  In this case, we draw a
+-- horizontal line through the center of the current window and consider all
+-- windows that intersect this horizontal line and whose right boundaries are to
+-- the left of the left boundary of the current window.  From among these
+-- windows, we choose the one with the rightmost right boundary.
+lineNavigation :: Navigation2D
+lineNavigation = N 1 doLineNavigation
+
+-- | Center navigation.  Again, consider navigating to the left.  Then we
+-- consider the cone bounded by the two rays shot at 45-degree angles in
+-- north-west and south-west direction from the center of the current window.  A
+-- window is a candidate to receive the focus if its center lies in this cone.
+-- We choose the window whose center has minimum L1-distance from the current
+-- window center.  The tie breaking strategy for windows with the same distance
+-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
+-- windows can be reached and that windows with the same center are traversed in
+-- their order in the window stack, that is, in the order
+-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
+-- them.
+centerNavigation :: Navigation2D
+centerNavigation = N 2 doCenterNavigation
+
+-- | Stores the configuration of directional navigation
+data Navigation2DConfig = Navigation2DConfig
+  { defaultTiledNavigation :: Navigation2D             -- ^ default navigation strategy for the tiled layer
+  , floatNavigation        :: Navigation2D             -- ^ navigation strategy for the float layer
+  , screenNavigation       :: Navigation2D             -- ^ strategy for navigation between screens
+  , layoutNavigation       :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
+                                                       -- for different layouts in the tiled layer.  Each pair
+                                                       -- is of the form (\"layout description\", navigation
+                                                       -- strategy).  If there is no pair in this list whose first
+                                                       -- component is the name of the current layout, the
+                                                       -- 'defaultTiledNavigation' strategy is used.
+  , unmappedWindowRect     :: [(String, Screen -> Window -> X (Maybe Rectangle))]
+                                                       -- ^ list associating functions to calculate rectangles
+                                                       -- for unmapped windows with layouts to which they are
+                                                       -- to be applied.  Each pair in this list is of
+                                                       -- the form (\"layout description\", function), where the
+                                                       -- function calculates a rectangle for a given unmapped
+                                                       -- window from the screen it is on and its window ID.
+                                                       -- See <#Finer_Points> for how to use this.
+  } deriving Typeable
+
+-- | Shorthand for the tedious screen type
+type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
+
+-- So we can store the configuration in extensible state
+instance ExtensionClass Navigation2DConfig where
+  initialValue = defaultNavigation2DConfig
+
+-- | Modifies the xmonad configuration to store the Navigation2D configuration
+withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
+withNavigation2DConfig conf2d xconf = xconf { startupHook  = startupHook xconf
+                                                          >> XS.put conf2d
+                                            }
+
+-- | Default navigation configuration.  It uses line navigation for the tiled
+-- layer and for navigation between screens, and center navigation for the float
+-- layer.  No custom navigation strategies or rectangles for unmapped windows are
+-- defined for individual layouts.
+defaultNavigation2DConfig :: Navigation2DConfig
+defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation
+                                               , floatNavigation        = centerNavigation
+                                               , screenNavigation       = lineNavigation
+                                               , layoutNavigation       = []
+                                               , unmappedWindowRect     = []
+                                               }
+
+-- | Switches focus to the closest window in the other layer (floating if the
+-- current window is tiled, tiled if the current window is floating).  Closest
+-- means that the L1-distance between the centers of the windows is minimized.
+switchLayer :: X ()
+switchLayer = actOnLayer otherLayer
+                         ( \ _ cur wins -> windows
+                           $ doFocusClosestWindow cur wins
+                         )
+                         ( \ _ cur wins -> windows
+                           $ doFocusClosestWindow cur wins
+                         )
+                         ( \ _ _ _ -> return () )
+                         False
+
+-- | Moves the focus to the next window in the given direction and in the same
+-- layer as the current window.  The second argument indicates whether
+-- navigation should wrap around (e.g., from the left edge of the leftmost
+-- screen to the right edge of the rightmost screen).
+windowGo :: Direction2D -> Bool -> X ()
+windowGo dir wrap = actOnLayer thisLayer
+                               ( \ conf cur wins -> windows
+                                 $ doTiledNavigation conf dir W.focusWindow cur wins
+                               )
+                               ( \ conf cur wins -> windows
+                                 $ doFloatNavigation conf dir W.focusWindow cur wins
+                               )
+                               ( \ conf cur wspcs -> windows
+                                 $ doScreenNavigation conf dir W.view cur wspcs
+                               )
+                               wrap
+
+-- | Swaps the current window with the next window in the given direction and in
+-- the same layer as the current window.  (In the floating layer, all that
+-- changes for the two windows is their stacking order if they're on the same
+-- screen.  If they're on different screens, each window is moved to the other
+-- window's screen but retains its position and size relative to the screen.)
+-- The second argument indicates wrapping (see 'windowGo').
+windowSwap :: Direction2D -> Bool -> X ()
+windowSwap dir wrap = actOnLayer thisLayer
+                                 ( \ conf cur wins -> windows
+                                   $ doTiledNavigation conf dir swap cur wins
+                                 )
+                                 ( \ conf cur wins -> windows
+                                   $ doFloatNavigation conf dir swap cur wins
+                                 )
+                                 ( \ _ _ _ -> return () )
+                                 wrap
+
+-- | Moves the current window to the next screen in the given direction.  The
+-- second argument indicates wrapping (see 'windowGo').
+windowToScreen :: Direction2D -> Bool -> X ()
+windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                         $ doScreenNavigation conf dir W.shift cur wspcs
+                                       )
+                                       wrap
+
+-- | Moves the focus to the next screen in the given direction.  The second
+-- argument indicates wrapping (see 'windowGo').
+screenGo :: Direction2D -> Bool -> X ()
+screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                   $ doScreenNavigation conf dir W.view cur wspcs
+                                 )
+                                 wrap
+
+-- | Swaps the workspace on the current screen with the workspace on the screen
+-- in the given direction.  The second argument indicates wrapping (see
+-- 'windowGo').
+screenSwap :: Direction2D -> Bool -> X ()
+screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                     $ doScreenNavigation conf dir W.greedyView cur wspcs
+                                   )
+                                   wrap
+
+-- | Maps each window to a fullscreen rect.  This may not be the same rectangle the
+-- window maps to under the Full layout or a similar layout if the layout
+-- respects statusbar struts.  In such cases, it may be better to use
+-- 'singleWindowRect'.
+fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
+fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)
+
+-- | Maps each window to the rectangle it would receive if it was the only
+-- window in the layout.  Useful, for example, for determining the default
+-- rectangle for unmapped windows in a Full layout that respects statusbar
+-- struts.
+singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
+singleWindowRect scr win  =  listToMaybe
+                          .  map snd
+                          .  fst
+                         <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })
+                                       (screenRect . W.screenDetail $ scr)
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                       PRIVATE X ACTIONS                                        --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Acts on the appropriate layer using the given action functions
+actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])                -- ^ Chooses which layer to operate on, relative
+                                                                   -- to the current window (same or other layer)
+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
+           -> (Navigation2DConfig -> WSRect  -> [WSRect]  -> X ()) -- ^ The action if the current workspace is empty
+           -> Bool                                                 -- ^ Should navigation wrap around screen edges?
+           -> X ()
+actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do
+  conf <- XS.get
+  (floating, tiled) <- navigableWindows conf wrap winset
+  let cur = W.peek winset
+  case cur of
+    Nothing                                   -> actOnScreens wsact wrap
+    Just w | Just rect <- L.lookup w tiled    -> tiledact conf (w, rect) (choice tiled floating)
+           | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)
+           | otherwise                        -> return ()
+
+-- | Returns the list of windows on the currently visible workspaces
+navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
+navigableWindows conf wrap winset  =  L.partition (\(win, _) -> M.member win (W.floating winset))
+                                   .  addWrapping winset wrap
+                                   .  catMaybes
+                                   .  concat
+                                  <$>
+                                   (  mapM ( \scr -> mapM (maybeWinRect scr)
+                                                   $ W.integrate'
+                                                   $ W.stack
+                                                   $ W.workspace scr
+                                           )
+                                   .  sortedScreens
+                                   )  winset
+  where
+    maybeWinRect scr win = do
+      winrect <- windowRect win
+      rect <- case winrect of
+                Just _  -> return winrect
+                Nothing -> maybe (return Nothing)
+                                 (\f -> f scr win)
+                                 (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))
+      return ((,) win <$> rect)
+
+-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
+windowRect :: Window -> X (Maybe Rectangle)
+windowRect win = withDisplay $ \dpy -> do
+  mp <- isMapped win
+  if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+                return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
+                `catchX` return Nothing
+        else return Nothing
+
+-- | Acts on the screens using the given action function
+actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
+             -> Bool  -- ^ Should wrapping be used?
+             -> X ()
+actOnScreens act wrap = withWindowSet $ \winset -> do
+  conf <- XS.get
+  let wsrects = visibleWorkspaces winset wrap
+      cur     = W.tag . W.workspace . W.current $ winset
+      rect    = fromJust $ L.lookup cur wsrects
+  act conf (cur, rect) wsrects
+
+-- | Determines whether a given window is mapped
+isMapped :: Window -> X Bool
+isMapped win  =  withDisplay
+              $  \dpy -> io
+              $  (waIsUnmapped /=)
+              .  wa_map_state
+             <$> getWindowAttributes dpy win
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                     PRIVATE PURE FUNCTIONS                                     --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Finds the window closest to the given window and focuses it. Ties are
+-- broken by choosing the first window in the window stack among the tied
+-- windows.  (The stack order is the one produced by integrate'ing each visible
+-- workspace's window stack and concatenating these lists for all visible
+-- workspaces.)
+doFocusClosestWindow :: WinRect
+                     -> [WinRect]
+                     -> (WindowSet -> WindowSet)
+doFocusClosestWindow (cur, rect) winrects
+  | null winctrs = id
+  | otherwise    = W.focusWindow . fst $ L.foldl1' closer winctrs
+  where
+    ctr     = centerOf rect
+    winctrs = filter ((cur /=) . fst)
+            $ map (\(w, r) -> (w, centerOf r)) winrects
+    closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
+                                   | otherwise                   = wc1
+
+-- | Implements navigation for the tiled layer
+doTiledNavigation :: Navigation2DConfig
+                  -> Direction2D
+                  -> (Window -> WindowSet -> WindowSet)
+                  -> WinRect
+                  -> [WinRect]
+                  -> (WindowSet -> WindowSet)
+doTiledNavigation conf dir act cur winrects winset
+  | Just win <- runNav nav dir cur winrects = act win winset
+  | otherwise                               = winset
+  where
+    layouts = map (description . W.layout . W.workspace)
+            $ W.screens winset
+    nav     = maximum
+            $ map ( fromMaybe (defaultTiledNavigation conf)
+                  . flip L.lookup (layoutNavigation conf)
+                  )
+            $ layouts
+
+-- | Implements navigation for the float layer
+doFloatNavigation :: Navigation2DConfig
+                  -> Direction2D
+                  -> (Window -> WindowSet -> WindowSet)
+                  -> WinRect
+                  -> [WinRect]
+                  -> (WindowSet -> WindowSet)
+doFloatNavigation conf dir act cur winrects
+  | Just win <- runNav nav dir cur winrects = act win
+  | otherwise                               = id
+  where
+    nav = floatNavigation conf
+
+-- | Implements navigation between screens
+doScreenNavigation :: Navigation2DConfig
+                   -> Direction2D
+                   -> (WorkspaceId -> WindowSet -> WindowSet)
+                   -> WSRect
+                   -> [WSRect]
+                   -> (WindowSet -> WindowSet)
+doScreenNavigation conf dir act cur wsrects
+  | Just ws <- runNav nav dir cur wsrects = act ws
+  | otherwise                             = id
+  where
+    nav = screenNavigation conf
+
+-- | Implements line navigation.  For layouts without overlapping windows, there
+-- is no need to break ties between equidistant windows.  When windows do
+-- overlap, even the best tie breaking rule cannot make line navigation feel
+-- natural.  Thus, we fairly arbtitrarily break ties by preferring the window
+-- that comes first in the window stack.  (The stack order is the one produced
+-- by integrate'ing each visible workspace's window stack and concatenating
+-- these lists for all visible workspaces.)
+doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+doLineNavigation dir (cur, rect) winrects
+  | null winrects' = Nothing
+  | otherwise      = Just . fst $ L.foldl1' closer winrects'
+  where
+    -- The current window's center
+    ctr@(xc, yc)  = centerOf rect
+
+    -- The list of windows that are candidates to receive focus.
+    winrects'     = filter dirFilter
+                  $ filter ((cur /=) . fst)
+                  $ winrects
+
+    -- Decides whether a given window matches the criteria to be a candidate to
+    -- receive the focus.
+    dirFilter (_, r) =  (dir == L && leftOf r rect && intersectsY yc r)
+                     || (dir == R && leftOf rect r && intersectsY yc r)
+                     || (dir == U && above  r rect && intersectsX xc r)
+                     || (dir == D && above  rect r && intersectsX xc r)
+
+    -- Decide whether r1 is left of/above r2.
+    leftOf r1 r2 = rect_x r1 + fi (rect_width  r1) <= rect_x r2
+    above  r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2
+
+    -- Check whether r's x-/y-range contains the given x-/y-coordinate.
+    intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width  r) >= x
+    intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y
+
+    -- Decides whether r1 is closer to the current window's center than r2
+    closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2
+                                   | otherwise                 = wr1
+
+    -- Returns the distance of r from the point (x, y)
+    dist (x, y) r | dir == L  = x - rect_x r - fi (rect_width r)
+                  | dir == R  = rect_x r - x
+                  | dir == U  = y - rect_y r - fi (rect_height r)
+                  | otherwise = rect_y r - y
+
+-- | Implements center navigation
+doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+doCenterNavigation dir (cur, rect) winrects
+  | ((w, _):_) <- onCtr' = Just w
+  | otherwise            = closestOffCtr
+  where
+    -- The center of the current window
+    (xc, yc) = centerOf rect
+
+    -- All the windows with their center points relative to the current
+    -- center rotated so the right cone becomes the relevant cone.
+    -- The windows are ordered in the order they should be preferred
+    -- when they are otherwise tied.
+    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
+            $ stackTransform
+            $ winrects
+
+    -- Give preference to windows later in the stack for going left or up and to
+    -- windows earlier in the stack for going right or down.  (The stack order
+    -- is the one produced by integrate'ing each visible workspace's window
+    -- stack and concatenating these lists for all visible workspaces.)
+    stackTransform | dir == L || dir == U = reverse
+                   | otherwise            = id
+
+    -- Transform a point into a difference to the current window center and
+    -- rotate it so that the relevant cone becomes the right cone.
+    dirTransform (x, y) | dir == R  = (  x - xc ,   y - yc )
+                        | dir == L  = (-(x - xc), -(y - yc))
+                        | dir == D  = (  y - yc ,   x - xc )
+                        | otherwise = (-(y - yc), -(x - xc))
+
+    -- Partition the points into points that coincide with the center
+    -- and points that do not.
+    (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs
+
+    -- All the points that coincide with the current center and succeed it
+    -- in the (appropriately ordered) window stack.
+    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
+             -- tail should be safe here because cur should be in onCtr
+
+    -- All the points that do not coincide with the current center and which
+    -- lie in the (rotated) right cone.
+    offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr
+
+    -- The off-center point closest to the center and
+    -- closest to the bottom ray of the cone.  Nothing if no off-center
+    -- point is in the cone
+    closestOffCtr = if null offCtr' then Nothing
+                                    else Just $ fst $ L.foldl1' closest offCtr'
+
+    closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))
+      | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p
+      | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p
+      | yq < yp                         = wq -- q is closer to the bottom ray than p
+      | otherwise                       = wp -- q is farther away from the bottom ray than p
+                                             -- or it has the same distance but comes later
+                                             -- in the window stack
+
+-- | Swaps the current window with the window given as argument
+swap :: Window -> WindowSet -> WindowSet
+swap win winset = W.focusWindow cur
+                $ L.foldl' (flip W.focusWindow) newwinset newfocused
+  where
+    -- The current window
+    cur      = fromJust $ W.peek winset
+
+    -- All screens
+    scrs     = W.screens winset
+
+    -- All visible workspaces
+    visws    = map W.workspace scrs
+
+    -- The focused windows of the visible workspaces
+    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
+
+    -- The window lists of the visible workspaces
+    wins     = map (W.integrate' . W.stack) visws
+
+    -- Update focused windows and window lists to reflect swap of windows.
+    newfocused = map swapWins focused
+    newwins    = map (map swapWins) wins
+
+    -- Replaces the current window with the argument window and vice versa.
+    swapWins x | x == cur  = win
+               | x == win  = cur
+               | otherwise = x
+
+    -- Reconstruct the workspaces' window stacks to reflect the swap.
+    newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
+    newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
+    newwinset = winset { W.current = head newscrs
+                       , W.visible = tail newscrs
+                       }
+
+-- | Calculates the center of a rectangle
+centerOf :: Rectangle -> (Position, Position)
+centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
+
+-- | Shorthand for integer conversions
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+-- | Functions to choose the subset of windows to operate on
+thisLayer, otherLayer :: a -> a -> a
+thisLayer  = curry fst
+otherLayer = curry snd
+
+-- | Returns the list of visible workspaces and their screen rects
+visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
+visibleWorkspaces winset wrap = addWrapping winset wrap
+                              $ map ( \scr -> ( W.tag . W.workspace         $ scr
+                                              , screenRect . W.screenDetail $ scr
+                                              )
+                                    )
+                              $ sortedScreens winset
+
+-- | Creates five copies of each (window/workspace, rect) pair in the input: the
+-- original and four offset one desktop size (desktop = collection of all
+-- screens) to the left, to the right, up, and down.  Wrap-around at desktop
+-- edges is implemented by navigating into these displaced copies.
+addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
+            -> Bool      -- ^ Should wrapping be used?  Do nothing if not.
+            -> [Rect a]  -- ^ Input set of (window/workspace, rect) pairs
+            -> [Rect a]
+addWrapping _      False wrects = wrects
+addWrapping winset True  wrects = [ (w, r { rect_x = rect_x r + fi x
+                                          , rect_y = rect_y r + fi y
+                                          }
+                                    )
+                                  | (w, r) <- wrects
+                                  , (x, y)  <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]
+                                  ]
+  where
+    (xoff, yoff) = wrapOffsets winset
+
+-- | Calculates the offsets for window/screen coordinates for the duplication
+-- of windows/workspaces that implements wrap-around.
+wrapOffsets :: WindowSet -> (Integer, Integer)
+wrapOffsets winset = (max_x - min_x, max_y - min_y)
+  where
+    min_x = fi $ minimum $ map rect_x rects
+    min_y = fi $ minimum $ map rect_y rects
+    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects
+    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
+    rects = map snd $ visibleWorkspaces winset False
+
+
+-- | Returns the list of screens sorted primarily by their centers'
+-- x-coordinates and secondarily by their y-coordinates.
+sortedScreens :: WindowSet -> [Screen]
+sortedScreens winset = L.sortBy cmp
+                     $ W.screens winset
+  where
+    cmp s1 s2 | x1 < x2   = LT
+              | x1 > x2   = GT
+              | y1 < x2   = LT
+              | y1 > y2   = GT
+              | otherwise = EQ
+      where
+        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
+        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
+
+
+-- | Calculates the L1-distance between two points.
+lDist :: (Position, Position) -> (Position, Position) -> Int
+lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)

XMonad/Actions/OnScreen.hs

@@ -15,17 +15,137 @@
 module XMonad.Actions.OnScreen (
     -- * Usage
     -- $usage
-    onScreen
+      onScreen
+    , onScreen'
+    , Focus(..)
     , viewOnScreen
     , greedyViewOnScreen
     , onlyOnScreen
+    , toggleOnScreen
+    , toggleGreedyOnScreen
     ) where
 
-import XMonad.StackSet
-import Control.Monad(guard)
-import Data.List
-import Data.Maybe(fromMaybe)
-import Data.Function(on)
+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
 --
@@ -60,56 +180,9 @@ import Data.Function(on)
 --
 -- A more basic version inside the default keybindings would be:
 --
--- >        , ((modm .|. 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".
+-- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
-
--- | Switch to the (hidden) workspace with index 'i' on the screen 'sc'.
--- A default function (for example 'view' or 'greedyView') will be run if 'sc' is
--- the current screen, no valid screen id or workspace 'i' is already visible.
-onScreen :: (Eq sid, Eq i)
-          => (i -> StackSet i l a sid sd -> StackSet i l a sid sd) -- ^ default action
-          -> sid                      -- ^ screen id
-          -> i                        -- ^ index of the workspace
-          -> StackSet i l a sid sd    -- ^ current stack
-          -> StackSet i l a sid sd
-onScreen defFunc sc i st = fromMaybe (defFunc i st) $ do
-    -- on unfocused current screen
-    guard $ screen (current st) /= sc
-    x <- find ((i==) . tag    ) (hidden  st)
-    s <- find ((sc==) . screen) (screens st)
-    o <- find ((sc==) . screen) (visible st)
-    let newScreen = s { workspace = x }
-    return st { visible   = newScreen : deleteBy ((==) `on` screen) newScreen (visible st)
-              , hidden    = workspace o : deleteBy ((==) `on` tag) x (hidden st)
-              }
-
--- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'greedyView'
--- to switch the current workspace with workspace 'i'.
-greedyViewOnScreen :: (Eq sid, Eq i)
-    => sid                          -- ^ screen id
-    -> i                            -- ^ index of the workspace
-    -> StackSet i l a sid sd        -- ^ current stack
-    -> StackSet i l a sid sd
-greedyViewOnScreen = onScreen greedyView
-
--- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible use 'view' to
--- switch focus to the workspace 'i'.
-viewOnScreen :: (Eq sid, Eq i)
-    => sid                          -- ^ screen id
-    -> i                            -- ^ index of the workspace
-    -> StackSet i l a sid sd        -- ^ current stack
-    -> StackSet i l a sid sd
-viewOnScreen = onScreen view
-
--- | Switch to workspace 'i' on screen 'sc'. If 'i' is visible do nothing.
-onlyOnScreen :: (Eq sid, Eq i)
-    => sid                          -- ^ screen id
-    -> i                            -- ^ index of the workspace
-    -> StackSet i l a sid sd        -- ^ current stack
-    -> StackSet i l a sid sd
-onlyOnScreen = onScreen doNothing
-  where doNothing _ st = st

XMonad/Actions/PerWorkspaceKeys.hs

@@ -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

@@ -19,15 +19,14 @@ module XMonad.Actions.PhysicalScreens (
                                       , getScreen
                                       , viewScreen
                                       , sendToScreen
+                                      , onNextNeighbour
+                                      , onPrevNeighbour
                                       ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import qualified Graphics.X11.Xlib as X
-import Graphics.X11.Xinerama
-
-import Data.List (sortBy)
+import Data.List (sortBy,findIndex)
 import Data.Function (on)
 
 {- $usage
@@ -42,7 +41,12 @@ and then left-to-right.
 
 Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 
-> import XMonad.Actions.PhysicalSCreens
+> 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
@@ -61,12 +65,12 @@ newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real
 
 -- | Translate a physical screen index to a "ScreenId"
 getScreen :: PhysicalScreen -> X (Maybe ScreenId)
-getScreen (P i) = withDisplay $ \dpy -> do
-                    screens <- io $ getScreenInfo dpy
-                    if i >= length screens
-                     then return Nothing
-                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]
-                          in return $ Just $ snd $ ss !! i
+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 ()
@@ -85,4 +89,26 @@ sendToScreen p = do i <- getScreen p
 -- | 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)
+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

@@ -110,7 +110,7 @@ plane ::
     (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
     X ()
 plane function numberLines_ limits direction = do
-    state <- get
+    st <- get
     xconf <- ask
 
     numberLines <-
@@ -205,7 +205,7 @@ plane function numberLines_ limits direction = do
         preColumns = div areas numberLines
 
         mCurrentWS :: Maybe Int
-        mCurrentWS = elemIndex (currentTag $ windowset state) areaNames
+        mCurrentWS = elemIndex (currentTag $ windowset st) areaNames
 
         areas :: Int
         areas = length areaNames

XMonad/Actions/Search.hs

@@ -44,26 +44,32 @@ module XMonad.Actions.Search (   -- * Usage
                                  lucky,
                                  maps,
                                  mathworld,
+                                 openstreetmap,
                                  scholar,
                                  thesaurus,
                                  wayback,
                                  wikipedia,
                                  wiktionary,
                                  youtube,
-                                 multi
+                                 multi,
                                   -- * Use case: searching with a submap
                                   -- $tip
+
+                                  -- * Types
+                                 Browser, Site, Query, Name, Search
                           ) where
 
-import Data.Char (chr, ord, isAlpha, isMark, isDigit)
+import Codec.Binary.UTF8.String (encode)
+import Data.Char (isAlphaNum, isAscii)
 import Data.List (isPrefixOf)
-import Numeric (showIntAtBase)
+import Text.Printf
 import XMonad (X(), MonadIO, liftIO)
-import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP)
+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
@@ -120,6 +126,8 @@ import XMonad.Util.XSelection (getSelection)
 
 * 'mathworld' -- Wolfram MathWorld search.
 
+* 'openstreetmap' -- OpenStreetMap free wiki world map.
+
 * 'scholar' -- Google scholar academic search.
 
 * 'thesaurus' -- thesaurus.reference.com search.
@@ -194,31 +202,18 @@ 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
@@ -258,8 +253,8 @@ searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
 
 > searchFunc :: String -> String
-> searchFunc s | s `isPrefixOf` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
->              | s `isPrefixOf` "http://" = s
+> 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
 
@@ -276,36 +271,34 @@ searchEngineF = SearchEngine
 
 -- The engines.
 amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
-  images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary,
+  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary,
   youtube :: SearchEngine
-amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
-alpha      = searchEngine "alpha"      "http://www.wolframalpha.com/input/?i="
-codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
-deb        = searchEngine "deb"        "http://packages.debian.org/"
-debbts     = searchEngine "debbts"     "http://bugs.debian.org/"
-debpts     = searchEngine "debpts"     "http://packages.qa.debian.org/"
-dictionary = searchEngine "dict"       "http://dictionary.reference.com/browse/"
-google     = searchEngine "google"     "http://www.google.com/search?num=100&q="
-hackage    = searchEngine "hackage"    "http://hackage.haskell.org/package/"
-hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="
-images     = searchEngine "images"     "http://images.google.fr/images?q="
-imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="
-isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="
-lucky      = searchEngine "lucky"      "http://www.google.com/search?btnI&q="
-maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
-mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
-scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
-thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
-wikipedia  = searchEngine "wiki"       "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
-wiktionary = searchEngine "wikt"      "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
-youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
-{- This doesn't seem to work, but nevertheless, it seems to be the official
-   method at <http://web.archive.org/collections/web/advanced.html> to get the
-   latest backup. -}
-wayback   = searchEngine "wayback" "http://web.archive.org/"
+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, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
+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
@@ -334,14 +327,14 @@ removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
   \"mathworld:integral\" will search mathworld, and everything else will fall back to
   google. The use of intelligent will make sure that URLs are opened directly. -}
 (!>) :: SearchEngine -> SearchEngine -> SearchEngine
-(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s)
+(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 s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s)
+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

XMonad/Actions/ShowText.hs

@@ -0,0 +1,116 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.ShowText
+-- Copyright   :  (c) Mario Pastorelli (2012)
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  pastorelli.mario@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"
+-- which offers more features (currently)
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.ShowText
+    ( -- * Usage
+      -- $usage
+      defaultSTConfig
+    , handleTimerEvent
+    , flashText
+    , ShowTextConfig(..)
+    ) where
+
+import Control.Monad (when)
+import Data.Map (Map,empty,insert,lookup)
+import Data.Monoid (mempty, All)
+import Prelude hiding (lookup)
+import XMonad
+import XMonad.StackSet (current,screen)
+import XMonad.Util.Font (Align(AlignCenter)
+                       , initXMF
+                       , releaseXMF
+                       , textExtentsXMF
+                       , textWidthXMF)
+import XMonad.Util.Timer (startTimer)
+import XMonad.Util.XUtils (createNewWindow
+                         , deleteWindow
+                         , fi
+                         , showWindow
+                         , paintAndWrite)
+import qualified XMonad.Util.ExtensibleState as ES
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.ShowText
+--
+-- Then add the event hook handler:
+--
+-- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
+--
+-- You can then use flashText in your keybindings:
+--
+-- > ((modMask, xK_Right), flashText defaultSTConfig 1 "->" >> nextWS)
+--
+
+-- | ShowText contains the map with timers as keys and created windows as values
+newtype ShowText = ShowText (Map Atom Window)
+    deriving (Read,Show,Typeable)
+
+instance ExtensionClass ShowText where
+    initialValue = ShowText empty
+
+-- | Utility to modify a ShowText
+modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
+modShowText f (ShowText m) = ShowText $ f m
+
+data ShowTextConfig =
+    STC { st_font :: String -- ^ Font name
+        , st_bg   :: String -- ^ Background color
+        , st_fg   :: String -- ^ Foreground color
+    }
+
+defaultSTConfig :: ShowTextConfig
+defaultSTConfig =
+    STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+        , st_bg   = "black"
+        , st_fg   = "white"
+    }
+
+-- | Handles timer events that notify when a window should be removed
+handleTimerEvent :: Event -> X All
+handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
+    (ShowText m) <- ES.get :: X ShowText
+    a <- io $ internAtom dis "XMONAD_TIMER" False
+    when (mtyp == a && length d >= 1)
+         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
+    mempty
+handleTimerEvent _ = mempty
+
+-- | Shows a window in the center of the screen with the given text
+flashText :: ShowTextConfig
+    -> Rational -- ^ number of seconds
+    -> String -- ^ text to display
+    -> X ()
+flashText c i s = do
+  f <- initXMF (st_font c)
+  d <- asks display
+  sc <- gets $ fi . screen . current . windowset
+  width <- textWidthXMF d f s
+  (as,ds) <- textExtentsXMF f s
+  let hight = as + ds
+      ht    = displayHeight d sc
+      wh    = displayWidth d sc
+      y     = (fi ht - hight + 2) `div` 2
+      x     = (fi wh - width + 2) `div` 2
+  w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight))
+                      Nothing "" True
+  showWindow w
+  paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) ""
+                (st_fg c) (st_bg c) [AlignCenter] [s]
+  releaseXMF f
+  io $ sync d False
+  t <- startTimer i
+  ES.modify $ modShowText (insert (fromIntegral t) w)

XMonad/Actions/SpawnOn.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.SpawnOn
@@ -18,7 +19,6 @@ module XMonad.Actions.SpawnOn (
     -- * Usage
     -- $usage
     Spawner,
-    mkSpawner,
     manageSpawn,
     spawnHere,
     spawnOn,
@@ -28,7 +28,6 @@ module XMonad.Actions.SpawnOn (
 ) where
 
 import Data.List (isInfixOf)
-import Data.IORef
 import System.Posix.Types (ProcessID)
 
 import XMonad
@@ -37,6 +36,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.ManageHelpers
 import XMonad.Prompt
 import XMonad.Prompt.Shell
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -44,17 +44,16 @@ import XMonad.Prompt.Shell
 -- >    import XMonad.Actions.SpawnOn
 --
 -- >    main = do
--- >      sp <- mkSpawner
 -- >      xmonad defaultConfig {
 -- >         ...
--- >         manageHook = manageSpawn sp <+> manageHook defaultConfig
+-- >         manageHook = manageSpawn <+> manageHook defaultConfig
 -- >         ...
 -- >      }
 --
 -- To ensure that application appears on a workspace it was launched at, add keybindings like:
 --
--- >  , ((mod1Mask,xK_o), spawnHere sp "urxvt")
--- >  , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig)
+-- >  , ((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).
@@ -62,26 +61,29 @@ import XMonad.Prompt.Shell
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
-newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, ManageHook)]}
+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable
+
+instance ExtensionClass Spawner where
+    initialValue = Spawner []
 
 maxPids :: Int
 maxPids = 5
 
--- | Create 'Spawner' which then has to be passed to other functions.
-mkSpawner :: (Functor m, MonadIO m) => m Spawner
-mkSpawner = io . fmap Spawner $ newIORef []
+-- | Get the current Spawner or create one if it doesn't exist.
+modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
+modifySpawner f = XS.modify (Spawner . f . pidsRef)
 
 -- | Provides a manage hook to react on process spawned with
 -- 'spawnOn', 'spawnHere' etc.
-manageSpawn :: Spawner -> ManageHook
-manageSpawn sp = do
-    pids <- io . readIORef $ pidsRef sp
+manageSpawn :: ManageHook
+manageSpawn = do
+    Spawner pids <- liftX XS.get
     mp <- pid
     case flip lookup pids =<< mp of
-        Nothing -> doF id
+        Nothing -> idHook
         Just mh  -> do
             whenJust mp $ \p ->
-                io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst)
+                liftX . modifySpawner $ filter ((/= p) . fst)
             mh
 
 mkPrompt :: (String -> X ()) -> XPConfig -> X ()
@@ -91,32 +93,31 @@ mkPrompt cb c = do
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
 -- application on current workspace.
-shellPromptHere :: Spawner -> XPConfig -> X ()
-shellPromptHere sp = mkPrompt (spawnHere sp)
+shellPromptHere :: XPConfig -> X ()
+shellPromptHere = mkPrompt spawnHere
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
 -- application on given workspace.
-shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()
-shellPromptOn sp ws = mkPrompt (spawnOn sp ws)
+shellPromptOn :: WorkspaceId -> XPConfig -> X ()
+shellPromptOn ws = mkPrompt (spawnOn ws)
 
 -- | Replacement for 'spawn' which launches
 -- application on current workspace.
-spawnHere :: Spawner -> String -> X ()
-spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd
+spawnHere :: String -> X ()
+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
 
 -- | Replacement for 'spawn' which launches
 -- application on given workspace.
-spawnOn :: Spawner -> WorkspaceId -> String -> X ()
-spawnOn sp ws cmd = spawnAndDo sp (doShift ws) cmd
+spawnOn :: WorkspaceId -> String -> X ()
+spawnOn ws cmd = spawnAndDo (doShift ws) cmd
 
 -- | Spawn an application and apply the manage hook when it opens.
-spawnAndDo :: Spawner -> ManageHook -> String -> X ()
-spawnAndDo sp mh cmd = do
+spawnAndDo :: ManageHook -> String -> X ()
+spawnAndDo mh cmd = do
     p <- spawnPID $ mangle cmd
-    io $ modifyIORef (pidsRef sp) (take maxPids . ((p,mh) :))
+    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

@@ -76,6 +76,7 @@ submapDefault def keys = do
             else return (m, keysym)
     -- Remove num lock mask and Xkb group state bits
     m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
-    maybe def id (M.lookup (m', s) keys)
 
     io $ ungrabKeyboard d currentTime
+
+    maybe def id (M.lookup (m', s) keys)

XMonad/Actions/SwapWorkspaces.hs

@@ -25,7 +25,6 @@ module XMonad.Actions.SwapWorkspaces (
 import XMonad (windows, X())
 import XMonad.StackSet
 import XMonad.Actions.CycleWS
-import XMonad.Util.Types
 import XMonad.Util.WorkspaceCompare
 
 

XMonad/Actions/TagWindows.hs

@@ -22,17 +22,22 @@ module XMonad.Actions.TagWindows (
                  focusDownTagged, focusDownTaggedGlobal,
                  shiftHere, shiftToScreen,
                  tagPrompt,
-                 tagDelPrompt
+                 tagDelPrompt,
+                 TagPrompt,
                  ) where
 
-import Data.List (nub,concat,sortBy)
+import Data.List (nub,sortBy)
 import Control.Monad
+import Control.Exception as E
 
 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@:
@@ -76,10 +81,10 @@ setTag s w = withDisplay $ \d ->
 --   reads from the \"_XMONAD_TAGS\" window property
 getTags :: Window -> X [String]
 getTags w = withDisplay $ \d ->
-    io $ catch (internAtom d "_XMONAD_TAGS" False >>=
+    io $ E.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

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.TopicSpace
@@ -21,8 +22,10 @@ module XMonad.Actions.TopicSpace
    Topic
   , Dir
   , TopicConfig(..)
+  , defaultTopicConfig
   , getLastFocusedTopics
   , setLastFocusedTopic
+  , reverseLastFocusedTopics
   , pprWindowSet
   , topicActionWithPrompt
   , topicAction
@@ -39,13 +42,12 @@ where
 import XMonad
 
 import Data.List
-import Data.Maybe (fromMaybe, isNothing, listToMaybe)
+import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
 import Data.Ord
 import qualified Data.Map as M
-import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
+import Control.Monad (liftM2,when,unless,replicateM_)
 import System.IO
 
-import XMonad.Operations
 import qualified XMonad.StackSet as W
 
 import XMonad.Prompt
@@ -56,7 +58,7 @@ import XMonad.Hooks.DynamicLog (PP(..))
 import qualified XMonad.Hooks.DynamicLog as DL
 
 import XMonad.Util.Run (spawnPipe)
-import XMonad.Util.StringProp(getStringListProp,setStringListProp)
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $overview
 -- This module allows to organize your workspaces on a precise topic basis.  So
@@ -74,129 +76,108 @@ import XMonad.Util.StringProp(getStringListProp,setStringListProp)
 -- $usage
 -- Here is an example of configuration using TopicSpace:
 --
--- @
--- -- The list of all topics/workspaces of your xmonad configuration.
--- -- The order is important, new topics must be inserted
--- -- at the end of the list if you want hot-restarting
--- -- to work.
--- myTopics :: [Topic]
--- myTopics =
---   [ \"dashboard\" -- the first one
---   , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\"
---   , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\"
---   , \"yi\", \"documents\", \"twitter\", \"pdf\"
---   ]
--- @
---
--- @
---  myTopicConfig :: TopicConfig
---  myTopicConfig = TopicConfig
---    { topicDirs = M.fromList $
---        [ (\"conf\", \"w\/conf\")
---        , (\"dashboard\", \"Desktop\")
---        , (\"yi\", \"w\/dev-haskell\/yi\")
---        , (\"darcs\", \"w\/dev-haskell\/darcs\")
---        , (\"haskell\", \"w\/dev-haskell\")
---        , (\"xmonad\", \"w\/dev-haskell\/xmonad\")
---        , (\"tools\", \"w\/tools\")
---        , (\"movie\", \"Movies\")
---        , (\"talk\", \"w\/talks\")
---        , (\"music\", \"Music\")
---        , (\"documents\", \"w\/documents\")
---        , (\"pdf\", \"w\/documents\")
---        ]
---    , defaultTopicAction = const $ spawnShell >*> 3
---    , defaultTopic = \"dashboard\"
---    , maxTopicHistory = 10
---    , topicActions = M.fromList $
---        [ (\"conf\",       spawnShell >> spawnShellIn \"wd\/ertai\/private\")
---        , (\"darcs\",      spawnShell >*> 3)
---        , (\"yi\",         spawnShell >*> 3)
---        , (\"haskell\",    spawnShell >*> 2 >>
---                         spawnShellIn \"wd\/dev-haskell\/ghc\")
---        , (\"xmonad\",     spawnShellIn \"wd\/x11-wm\/xmonad\" >>
---                         spawnShellIn \"wd\/x11-wm\/xmonad\/contrib\" >>
---                         spawnShellIn \"wd\/x11-wm\/xmonad\/utils\" >>
---                         spawnShellIn \".xmonad\" >>
---                         spawnShellIn \".xmonad\")
---        , (\"mail\",       mailAction)
---        , (\"irc\",        ssh somewhere)
---        , (\"admin\",      ssh somewhere >>
---                         ssh nowhere)
---        , (\"dashboard\",  spawnShell)
---        , (\"twitter\",    spawnShell)
---        , (\"web\",        spawn browserCmd)
---        , (\"movie\",      spawnShell)
---        , (\"documents\",  spawnShell >*> 2 >>
---                         spawnShellIn \"Documents\" >*> 2)
---        , (\"pdf\",        spawn pdfViewerCmd)
---        ]
---    }
--- @
---
--- @
---  -- extend your keybindings
---  myKeys conf\@XConfig{modMask=modm} =
---    [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
---    , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
---    , ((modm              , xK_g     ), promptedGoto)
---    , ((modm .|. shiftMask, xK_g     ), promptedShift)
---    ...
---    ]
---    ++
---    [ ((modm, k), switchNthLastFocused myTopicConfig i)
---    | (i, k) <- zip [1..] workspaceKeys]
--- @
---
--- @
---  spawnShell :: X ()
---  spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
--- @
---
--- @
---  spawnShellIn :: Dir -> X ()
---  spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\"
--- @
---
--- @
---  goto :: Topic -> X ()
---  goto = switchTopic myTopicConfig
--- @
---
--- @
---  promptedGoto :: X ()
---  promptedGoto = workspacePrompt myXPConfig goto
--- @
---
--- @
---  promptedShift :: X ()
---  promptedShift = workspacePrompt myXPConfig $ windows . W.shift
--- @
---
--- @
---  myConfig = do
---      checkTopicConfig myTopics myTopicConfig
---      myLogHook <- makeMyLogHook
---      return $ defaultConfig
---           { borderWidth = 1 -- Width of the window border in pixels.
---           , workspaces = myTopics
---           , layoutHook = myModifiers myLayout
---           , manageHook = myManageHook
---           , logHook = myLogHook
---           , handleEventHook = myHandleEventHook
---           , terminal = myTerminal -- The preferred terminal program.
---           , normalBorderColor = \"#3f3c6d\"
---           , focusedBorderColor = \"#4f66ff\"
---           , XMonad.modMask = mod1Mask
---           , keys = myKeys
---           , mouseBindings = myMouseBindings
---           }
--- @
---
--- @
---  main :: IO ()
---  main = xmonad =<< myConfig
--- @
+-- > -- 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 ()
@@ -225,19 +206,37 @@ data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
                                  -- 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.
--- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES.
 getLastFocusedTopics :: X [String]
-getLastFocusedTopics = asks display >>= flip getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"
+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 :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
-setLastFocusedTopic tg w predicate = do
-  disp <- asks display
-  setStringListProp disp "_XMONAD_LAST_FOCUSED_WORKSPACES"
-    . take (maxTopicHistory tg) . nub . (w:) . filter predicate =<< getLastFocusedTopics
+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
@@ -248,13 +247,13 @@ pprWindowSet tg pp = do
     urgents <- readUrgents
     let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
         maxDepth = maxTopicHistory tg
-    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)
-                           (`notElem` empty_workspaces)
+    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
+                        (`notElem` empty_workspaces)
     lastWs <- getLastFocusedTopics
-    let depth topic = elemIndex topic lastWs
-        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic
+    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 - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)
+        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
@@ -278,7 +277,7 @@ switchTopic tg topic = do
   when (null wins) $ topicAction tg topic
 
 -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
-switchNthLastFocused ::TopicConfig -> Int -> X ()
+switchNthLastFocused :: TopicConfig -> Int -> X ()
 switchNthLastFocused tg depth = do
   lastWs <- getLastFocusedTopics
   switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth

XMonad/Actions/UpdateFocus.hs

@@ -21,7 +21,6 @@ module XMonad.Actions.UpdateFocus (
 
 import XMonad
 import qualified XMonad.StackSet as W
-import Graphics.X11.Xlib.Extras
 import Control.Monad (when)
 import Data.Monoid
 
@@ -45,10 +44,10 @@ focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
     -- check only every 15 px to avoid excessive calls to translateCoordinates
     when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
       dpy <- asks display
-      Just foc <- withWindowSet $ return . W.peek
+      foc <- withWindowSet $ return . W.peek
       -- get the window under the pointer:
       (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)
-      when (foc /= w) $ focus w
+      when (foc /= Just w) $ focus w
     return (All True)
 focusOnMouseMove _ = return (All True)
 

XMonad/Actions/UpdatePointer.hs

@@ -24,6 +24,7 @@ module XMonad.Actions.UpdatePointer
     where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Control.Monad
 import XMonad.StackSet (member, peek, screenDetail, current)
 import Data.Maybe
@@ -91,8 +92,10 @@ updatePointer p = do
         where fraction x y = floor (x * fromIntegral y)
 
 windowAttributesToRectangle :: WindowAttributes -> Rectangle
-windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))     (fi (wa_y wa))
-                                           (fi (wa_width wa)) (fi (wa_height wa))
+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
@@ -100,6 +103,3 @@ moveWithin now lower upper =
     else if now > upper
          then upper
          else now
-
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral

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

XMonad/Actions/WindowBringer.hs

@@ -17,7 +17,9 @@
 module XMonad.Actions.WindowBringer (
                     -- * Usage
                     -- $usage
-                    gotoMenu, gotoMenu', bringMenu, windowMap,
+                    gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',
+                    bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',
+                    windowMap,
                     bringWindow
                    ) where
 
@@ -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
@@ -44,19 +46,54 @@ import XMonad.Util.NamedWindows (getName)
 -- 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

@@ -58,8 +58,9 @@ and define appropriate key bindings:
 
 (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". -}
@@ -79,8 +80,11 @@ ifWindows qry f el = withWindowSet $ \wins -> do
 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.
+{- | '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 . safeSpawnProg
 
@@ -110,7 +114,7 @@ raise = raiseMaybe $ return ()
    Mutt which you just did for Firefox - but Mutt runs inside a terminal window?
    No problem: you search for a terminal window calling itself \"mutt\", and if
    there isn't you run a terminal with a command to run Mutt! Here's an example
-   (borrowing 'runInTerm' from "XMonad.Utils.Run"):
+   (borrowing 'runInTerm' from "XMonad.Util.Run"):
 
   > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
 -}
@@ -159,11 +163,11 @@ raiseEditor  = raiseVar getEditor
 {- | If the window is found the window is focused and the third argument is called
      otherwise, the first argument is called
      See 'raiseMaster' for an example. -}
-raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()
+raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X ()
 raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f
     where afterRaise = ask >>= (>> idHook) . liftX . after
 
-{- | If a window matching the second arugment is found, the window is focused and the third argument is called;
+{- | If a window matching the second argument is found, the window is focused and the third argument is called;
      otherwise, the first argument is called. -}
 runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()
 runOrRaiseAndDo = raiseAndDo . safeSpawnProg
@@ -171,14 +175,14 @@ runOrRaiseAndDo = raiseAndDo . safeSpawnProg
 {- | if the window is found the window is focused and set to master
      otherwise, the first argument is called.
 
-     > raiseMaster (runInTerm \"-title ghci\"  \"zsh -c \'ghci\'\") (title =? \"ghci\") -}
+     > raiseMaster (runInTerm "-title ghci"  "zsh -c 'ghci'") (title =? "ghci") -}
 raiseMaster :: X () -> Query Bool -> X ()
 raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster)
 
 {- |  If the window is found the window is focused and set to master
       otherwise, action is run.
 
-      > runOrRaiseMaster \"firefox\" (className =? \"Firefox\"))
+      > runOrRaiseMaster "firefox" (className =? "Firefox"))
   -}
 runOrRaiseMaster :: String -> Query Bool -> X ()
 runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster)

XMonad/Actions/WindowMenu.hs

@@ -41,6 +41,14 @@ import XMonad.Util.XUtils (fi)
 --
 -- >    , ((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)
@@ -48,13 +56,13 @@ windowMenu = withFocused $ \w -> do
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
-        gsConfig = defaultGSConfig
+        gsConfig = (buildDefaultGSConfig colorizer)
                     { gs_originFractX = originFractX
                     , gs_originFractY = originFractY }
         actions = [ ("Cancel menu", return ())
                   , ("Close"      , kill)
                   , ("Maximize"   , sendMessage $ maximizeRestore w)
-                  , ("Minimize"   , sendMessage $ MinimizeWin w)
+                  , ("Minimize"   , minimizeWindow w)
                   ] ++
                   [ ("Move to " ++ tag, windows $ W.shift tag)
                     | tag <- tags ]

XMonad/Actions/WindowNavigation.hs

@@ -36,7 +36,7 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
-                                       Direction2D(..)
+                                       Direction2D(..), WNState,
                                        ) where
 
 import XMonad
@@ -52,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
 --

XMonad/Actions/WithAll.hs

@@ -18,8 +18,6 @@ module XMonad.Actions.WithAll (
 import Data.Foldable hiding (foldr)
 
 import XMonad
-import XMonad.Core
-import XMonad.Operations
 import XMonad.StackSet
 
 -- $usage

XMonad/Actions/Workscreen.hs

@@ -0,0 +1,109 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     :  XMonad.Actions.Workscreen
+-- Copyright  :  (c) 2012 kedals0
+-- License    :  BSD3-style (see LICENSE)
+--
+-- Maintainer :  Dal <kedasl0@gmail.com>
+-- Stability  :  unstable
+-- Portability:  unportable
+--
+-- A workscreen permits to display a set of workspaces on several
+-- screens. In xinerama mode, when a workscreen is viewed, workspaces
+-- associated to all screens are visible.
+--
+-- The first workspace of a workscreen is displayed on first screen,
+-- second on second screen, etc. Workspace position can be easily
+-- changed. If the current workscreen is called again, workspaces are
+-- shifted.
+--
+-- This also permits to see all workspaces of a workscreen even if just
+-- one screen is present, and to move windows from workspace to workscreen.
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.Workscreen (
+  -- * Usage
+  -- $usage
+  configWorkscreen
+  ,viewWorkscreen
+  ,Workscreen(..)
+  ,shiftToWorkscreen
+  ,fromWorkspace
+  ,expandWorkspace
+  ) where
+
+import XMonad hiding (workspaces)
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Actions.OnScreen
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Workscreen
+-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
+-- >                in Workscreen.expandWorkspace 2 myOldWorkspaces
+-- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)
+-- >                    return ()
+--
+-- Then, replace normal workspace view and shift keybinding:
+--
+-- > [((m .|. modm, k), f i)
+-- >      | (i, k) <- zip [0..] [1..12]
+-- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)
+type WorkscreenId=Int
+
+data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)
+instance ExtensionClass WorkscreenStorage where
+  initialValue = WorkscreenStorage 0 []
+
+-- | Helper to group workspaces. Multiply workspace by screens number.
+expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
+expandWorkspace nscr ws = concat $ map expandId ws
+  where expandId wsId = let t = wsId ++ "_"
+                        in map ((++) t . show ) [1..nscr]
+
+-- | Create workscreen list from workspace list. Group workspaces to
+-- packets of screens number size.
+fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
+fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
+fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
+fromWorkspace' _ [] = []
+fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
+
+-- | Initial configuration of workscreens
+configWorkscreen :: [Workscreen] -> X ()
+configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn)
+
+-- | View workscreen of index @WorkscreenId@. If current workscreen is asked
+-- workscreen, workscreen's workspaces are shifted.
+viewWorkscreen :: WorkscreenId -> X ()
+viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get
+                           let wscr = if wscrId == c
+                                          then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)
+                                          else a !! wscrId
+                               (x,_:ys) = splitAt wscrId a
+                               newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)
+                           windows (viewWorkscreen' wscr)
+                           XS.put newWorkscreenStorage
+
+viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
+viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws)
+  where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s
+
+shiftWs :: [WorkspaceId] -> [WorkspaceId]
+shiftWs a = drop 1 a ++ take 1 a
+
+-- | Shift a window on the first workspace of workscreen
+-- @WorkscreenId@.
+shiftToWorkscreen :: WorkscreenId -> X ()
+shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
+                              let ws = head . workspaces $ a !! wscrId
+                              windows $ W.shift ws

XMonad/Actions/WorkspaceCursors.hs

@@ -32,10 +32,13 @@ module XMonad.Actions.WorkspaceCursors
 
     -- * Functions to pass to 'modifyLayer'
     ,focusNth'
-    ,noWrapUp,noWrapDown
+    ,noWrapUp,noWrapDown,
 
     -- * Todo
     -- $todo
+
+    -- * Types
+    Cursors,
     ) where
 
 import qualified XMonad.StackSet as W

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

XMonad/Config/Azerty.hs

@@ -38,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

@@ -54,7 +54,6 @@ module XMonad.Config.Desktop (
     ) where
 
 import XMonad
-import XMonad.Config (defaultConfig)
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Util.Cursor
@@ -89,7 +88,7 @@ import qualified Data.Map as M
 
 -- $customizing
 -- To customize a desktop config, modify its fields as is illustrated with
--- @defaultConfig@ in the \"Extending xmonad\" section of "XMonad.Doc.Extending".
+-- @defaultConfig@ in "XMonad.Doc.Extending#Extending xmonad".
 
 -- $layouts
 -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
@@ -127,7 +126,7 @@ import qualified Data.Map as M
 -- To add to the logHook while still sending workspace and window information
 -- to DE apps use something like:
 --
--- >  , logHook = myLogHook >> logHook desktopConfig
+-- >  , logHook = myLogHook <+> logHook desktopConfig
 --
 -- Or for more elaborate logHooks you can use @do@:
 --
@@ -139,25 +138,23 @@ import qualified Data.Map as M
 
 -- $eventHook
 -- To customize xmonad's event handling while still having it respond
--- to EWMH events from pagers, task bars, etc. add to your imports:
+-- to EWMH events from pagers, task bars:
 --
--- > import Data.Monoid
+-- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig
 --
--- and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@)
---
--- >  , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig)
---
--- or 'Data.Monoid.mconcat' (like @composeAll@)
+-- 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
+-- time xmonad starts or restarts, use '<+>' to combine actions as in the
 -- logHook example, or something like:
 --
 -- >  , startupHook = do
@@ -170,7 +167,7 @@ desktopConfig = ewmh defaultConfig
     { startupHook     = setDefaultCursor xC_left_ptr
     , layoutHook      = desktopLayoutModifiers $ layoutHook defaultConfig
     , manageHook      = manageHook defaultConfig <+> manageDocks
-    , keys            = \c -> desktopKeys c `M.union` keys defaultConfig c }
+    , keys            = desktopKeys <+> keys defaultConfig }
 
 desktopKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_b), sendMessage ToggleStruts) ]

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

XMonad/Config/Gnome.hs

@@ -41,7 +41,7 @@ import System.Environment (getEnvironment)
 
 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 $

XMonad/Config/Kde.hs

@@ -40,11 +40,11 @@ import qualified Data.Map as M
 
 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/Sjanssen.hs

@@ -1,60 +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 "exec xmobar" sjanssenPP strutkey =<< sjanssenConfig
- where
-    strutkey (XConfig {modMask = modm}) = (modm, xK_b)
-
-sjanssenConfig = do
-    sp <- mkSpawner
-    return . ewmh $ defaultConfig
+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
+        , 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}) = M.fromList $
-        [((modm,               xK_p     ), shellPromptHere sp myPromptConfig)
-        ,((modm .|. shiftMask, xK_Return), spawnHere sp =<< asks (terminal . config))
+    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 $ 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

@@ -36,7 +36,7 @@ import qualified Data.Map as M
 
 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/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/Doc/Extending.hs

@@ -175,7 +175,7 @@ edit your key bindings.
 * "XMonad.Actions.FloatKeys":
     Move and resize floating windows.
 
-* "XMonad.Layout.FloatSnap":
+* "XMonad.Actions.FloatSnap":
     Move and resize floating windows using other windows and the edge of the
     screen as guidelines.
 
@@ -257,7 +257,7 @@ edit your key bindings.
 * "XMonad.Actions.UpdateFocus":
     Updates the focus on mouse move in unfocused windows.
 
-* "XMonadContrib.UpdatePointer":
+* "XMonad.Actions.UpdatePointer":
     Causes the pointer to follow whichever window focus changes to.
 
 * "XMonad.Actions.Warp":
@@ -382,13 +382,17 @@ Here is a list of the modules found in @XMonad.Hooks@:
 * "XMonad.Hooks.ManageHelpers": provide helper functions to be used
   in @manageHook@.
 
+* "XMonad.Hooks.Minimize":
+    Handles window manager hints to minimize and restore windows. Use
+    this with XMonad.Layout.Minimize.
+
 * "XMonad.Hooks.Place":
     Automatic placement of floating windows.
 
 * "XMonad.Hooks.RestoreMinimized":
-    Lets you restore minimized windows (see "XMonad.Layout.Minimize")
-    by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
-    and WM_CHANGE_STATE).
+    (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).
 
 * "XMonad.Hooks.Script":
     Provides a simple interface for running a ~\/.xmonad\/hooks script with the
@@ -932,16 +936,18 @@ example, you could write:
 
 and provide an appropriate definition of @myKeys@, such as:
 
-> myKeys conf@(XConfig {XMonad.modMask = modm}) =
+> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
 >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
 >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
 >             ]
 
 This particular definition also requires importing "XMonad.Prompt",
-"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":
+"XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map":
 
-> import XMonadPrompt
-> import ...  -- and so on
+> import qualified Data.Map as M
+> import XMonad.Prompt
+> import XMonad.Prompt.Shell
+> import XMonad.Prompt.XMonad
 
 For a list of the names of particular keys (such as xK_F12, and so
 on), see
@@ -977,7 +983,7 @@ module, before starting we must first import this modules:
 For instance, if you have defined some additional key bindings like
 these:
 
->    myKeys conf@(XConfig {XMonad.modMask = modm}) =
+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
 >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
 >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
 >             ]
@@ -985,13 +991,19 @@ these:
 then you can create a new key bindings map by joining the default one
 with yours:
 
->    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))
+>    newKeys x  = myKeys x `M.union` keys defaultConfig x
 
 Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field
 of the configuration:
 
 >    main = xmonad $ defaultConfig { keys = newKeys }
 
+Alternatively, the '<+>' operator can be used which in this usage does exactly
+the same as the explicit usage of 'M.union' and propagation of the config
+argument, thanks to appropriate instances in "Data.Monoid".
+
+>    main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
+
 All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
 
 
@@ -1006,11 +1018,9 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
 >    import XMonad.Prompt.XMonad
 >
 >    main :: IO ()
->    main = xmonad $ defaultConfig { keys = newKeys }
+>    main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
 >
->    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))
->
->    myKeys conf@(XConfig {XMonad.modMask = modm}) =
+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
 >             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
 >             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
 >             ]
@@ -1034,10 +1044,10 @@ For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
 to define @newKeys@ as a 'Data.Map.difference' between the default
 map and the map of the key bindings you want to remove.  Like so:
 
->    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)
+>    newKeys x = keys defaultConfig x `M.difference` keysToRemove x
 >
->    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]
->    keysToRemove x =
+>    keysToRemove :: XConfig Layout ->    M.Map (KeyMask, KeySym) (X ())
+>    keysToRemove x = M.fromList
 >             [ ((modm              , xK_q ), return ())
 >             , ((modm .|. shiftMask, xK_q ), return ())
 >             ]
@@ -1164,7 +1174,7 @@ Suppose we want a list with the 'XMonad.Layout.Full',
 
 Then we create the combination of layouts we need:
 
->    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion
+>    mylayoutHook = Full ||| tabbed shrinkText defaultTheme ||| Accordion
 
 
 Now, all we need to do is change the 'XMonad.Core.layoutHook'
@@ -1178,11 +1188,11 @@ example, suppose we want to use the
 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the
 "XMonad.Layout.NoBorders" module (which must be imported):
 
->    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)
+>    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTheme ||| Accordion)
 
 If we want only the tabbed layout without borders, then we may write:
 
->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion
 
 Our @~\/.xmonad\/xmonad.hs@ will now look like this:
 
@@ -1192,7 +1202,7 @@ Our @~\/.xmonad\/xmonad.hs@ will now look like this:
 >    import XMonad.Layout.Accordion
 >    import XMonad.Layout.NoBorders
 >
->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion
 >
 >    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
 

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

@@ -0,0 +1,93 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DebugStack
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Dump the state of the 'StackSet'.  A @logHook@ and @handleEventHook@ are
+-- also provided.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugStack (debugStack
+                               ,debugStackString
+                               ,debugStackLogHook
+                               ,debugStackEventHook
+                               ) where
+
+import           XMonad.Core
+import qualified XMonad.StackSet         as W
+
+import           XMonad.Util.DebugWindow
+
+import           Graphics.X11.Types                  (Window)
+import           Graphics.X11.Xlib.Extras            (Event)
+
+import           Control.Monad                       (foldM)
+import           Data.Map                            (toList)
+import           Data.Monoid                         (All(..))
+
+-- | Print the state of the current window stack to @stderr@, which for most
+--   installations goes to @~/.xsession-errors@.  "XMonad.Util.DebugWindow"
+--   is used to display the individual windows.
+debugStack :: X ()
+debugStack =  debugStackString >>= trace
+
+-- | The above packaged as a 'logHook'.  (Currently this is identical.)
+debugStackLogHook :: X ()
+debugStackLogHook =  debugStack
+
+-- | The above packaged as a 'handleEventHook'.  You almost certainly do not
+--   want to use this unconditionally, as it will cause massive amounts of
+--   output and possibly slow @xmonad@ down severely.
+
+debugStackEventHook   :: Event -> X All
+debugStackEventHook _ =  debugStack >> return (All True)
+
+-- | Dump the state of the current 'StackSet' as a multiline 'String'.
+--   @
+--   stack [    mm
+--         ,(*) ww
+--         ,    ww
+--         ]
+--   float {    ww
+--         ,    ww
+--         }
+--   @
+--
+-- One thing I'm not sure of is where the zipper is when focus is on a
+-- floating window.
+debugStackString :: X String
+debugStackString =  withWindowSet $ \ws -> do
+                      s <- emit "stack" ("[","]") (W.peek ws)                    $ W.index    ws
+                      f <- emit "float" ("{","}") (W.peek ws) $ map fst $ toList $ W.floating ws
+                      return $ s ++ f
+  where
+    emit :: String -> (String,String) -> Maybe Window -> [Window] -> X String
+    emit title (lb,rb) _       [] = return $ title ++ " " ++ lb ++ rb ++ "]\n"
+    emit title (lb,rb) focused ws = do
+      (_,_,_,_,ss) <- foldM emit' (title,lb,rb,focused,"") ws
+      return $ ss                               ++
+               replicate (length title + 1) ' ' ++
+               rb                               ++
+               "\n"
+
+    emit' :: (String,String,String,Maybe Window,String)
+          -> Window
+          -> X (String,String,String,Maybe Window,String)
+    emit' (t,l,r,f,a) w = do
+      w' <- emit'' f w
+      return (replicate (length t) ' '
+             ,',' : replicate (length l - 1) ' '
+             ,r
+             ,f
+             ,a ++ t ++ " " ++ l ++ w' ++ "\n"
+             )
+    emit'' :: Maybe Window -> Window -> X String
+    emit'' focus win =
+      let fi f = if win == f then "(*) " else "    "
+       in (maybe "    " fi focus ++) `fmap` debugWindow win

XMonad/Hooks/DynamicBars.hs

@@ -0,0 +1,136 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DynamicBars
+-- Copyright   :  (c) Ben Boeckel 2012
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  mathstuf@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Manage per-screen status bars.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicBars (
+  -- * Usage
+  -- $usage
+    DynamicStatusBar
+  , DynamicStatusBarCleanup
+  , dynStatusBarStartup
+  , dynStatusBarEventHook
+  , multiPP
+  ) where
+
+import Prelude
+
+import Control.Concurrent.MVar
+import Control.Monad
+import Control.Monad.Trans (lift)
+import Control.Monad.Writer (WriterT, execWriterT, tell)
+
+import Data.Maybe
+import Data.Monoid
+import Data.Traversable (traverse)
+
+import Graphics.X11.Xinerama
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xrandr
+
+import System.IO
+import System.IO.Unsafe
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.DynamicLog
+
+-- $usage
+-- Provides a few helper functions to manage per-screen status bars while
+-- dynamically responding to screen changes. A startup action, event hook, and
+-- a way to separate PP styles based on the screen's focus are provided:
+--
+-- * The 'dynStatusBarStartup' hook which initializes the status bars.
+--
+-- * The 'dynStatusBarEventHook' hook which respawns status bars when the
+-- number of screens changes.
+--
+-- * The 'multiPP' function which allows for different output based on whether
+-- the screen for the status bar has focus.
+--
+-- The hooks take a 'DynamicStatusBar' function which is given the id of the
+-- screen to start up and returns the 'Handle' to the pipe to write to. The
+-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It
+-- is called when the number of screens changes and on startup.
+--
+
+data DynStatusBarInfo = DynStatusBarInfo
+  { dsbInfoScreens :: [ScreenId]
+  , dsbInfoHandles :: [Handle]
+  }
+
+type DynamicStatusBar = ScreenId -> IO Handle
+type DynamicStatusBarCleanup = IO ()
+
+-- Global state
+statusBarInfo :: MVar DynStatusBarInfo
+statusBarInfo = unsafePerformIO $ newMVar (DynStatusBarInfo [] [])
+
+dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+dynStatusBarStartup sb cleanup = liftIO $ do
+  dpy <- openDisplay ""
+  xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
+  closeDisplay dpy
+  updateStatusBars sb cleanup
+
+dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
+dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = liftIO (updateStatusBars sb cleanup) >> return (All True)
+dynStatusBarEventHook _  _       _                              = return (All True)
+
+updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> IO ()
+updateStatusBars sb cleanup = liftIO $ do
+  dsbInfo <- takeMVar statusBarInfo
+  screens <- getScreens
+  if (screens /= (dsbInfoScreens dsbInfo))
+    then do
+      mapM hClose (dsbInfoHandles dsbInfo)
+      cleanup
+      newHandles <- mapM sb screens
+      putMVar statusBarInfo (DynStatusBarInfo screens newHandles)
+    else putMVar statusBarInfo dsbInfo
+
+-----------------------------------------------------------------------------
+-- The following code is from adamvo's xmonad.hs file.
+-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs
+
+multiPP :: PP -- ^ The PP to use if the screen is focused
+        -> PP -- ^ The PP to use otherwise
+        -> X ()
+multiPP focusPP unfocusPP = do
+  dsbInfo <- liftIO $ readMVar statusBarInfo
+  multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo)
+
+multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
+multiPP' dynlStr focusPP unfocusPP handles = do
+  st <- get
+  let pickPP :: WorkspaceId -> WriterT (Last XState) X String
+      pickPP ws = do
+        let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st
+        put st{ windowset = W.view ws $ windowset st }
+        out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
+        when isFoc $ get >>= tell . Last . Just
+        return out
+  traverse put . getLast
+    =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
+    =<< mapM screenWorkspace (zipWith const [0 .. ] handles)
+  return ()
+
+getScreens :: IO [ScreenId]
+getScreens = do
+  screens <- do
+    dpy <- openDisplay ""
+    rects <- getScreenInfo dpy
+    closeDisplay dpy
+    return rects
+  let ids = zip [0 .. ] screens
+  return $ map fst ids

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,68 +39,46 @@ 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
--- >                   [((modm, xK_i), oneShotHook dynHooksRef
--- >                    "FFlaunchHook" (className =? "firefox") (doShift "3")
--- >                    >> spawn "firefox")
--- >                   ,((modm, xK_u), addDynamicHook dynHooksRef
--- >                     (className =? "example" --> doFloat))
--- >                   ,((modm, xK_y), updatePermanentHook dynHooksRef
--- >                     (const idHook))) ]  -- resets the permanent hook.
+-- > ((modMask,xK_a), oneShotHook (className =? "example") doFloat)
 --
 
 data DynamicHooks = DynamicHooks
     { transients :: [(Query Bool, ManageHook)]
     , permanent  :: ManageHook }
+                    deriving Typeable
 
+instance ExtensionClass DynamicHooks where
+    initialValue = DynamicHooks [] idHook
 
--- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.
-initDynamicHooks :: IO (IORef DynamicHooks)
-initDynamicHooks = newIORef (DynamicHooks { transients = [],
-                                            permanent = idHook })
-
-
--- this hook is always executed, and the IORef's contents checked.
+-- 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:
@@ -112,11 +89,5 @@ updateDynamicHook ref f =
 --
 -- > 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,
@@ -51,24 +54,26 @@ module XMonad.Hooks.DynamicLog (
 
   ) where
 
---
 -- Useful imports
---
-import XMonad
-import Control.Monad
-import Data.Char ( isSpace )
+
+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
 
@@ -81,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
@@ -144,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.
@@ -167,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.
 --
@@ -198,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
 --
@@ -245,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
@@ -264,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
 
@@ -278,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
 
@@ -312,7 +346,7 @@ trim = f . f
 -- | 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 = "..."
 
@@ -339,11 +373,7 @@ dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)
 dzenEscape :: String -> String
 dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
 
--- | Strip dzen formatting or commands. Useful to remove ppHidden
---   formatting in ppUrgent field. For example:
---
--- >     , ppHidden          = dzenColor "gray20" "" . wrap "(" ")"
--- >     , ppUrgent          = dzenColor "dark orange" "" .  dzenStrip
+-- | Strip dzen formatting or commands.
 dzenStrip :: String -> String
 dzenStrip = strip [] where
     strip keep x
@@ -364,11 +394,7 @@ xmobarColor fg bg = wrap t "</fc>"
 
 -- ??? add an xmobarEscape function?
 
--- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent
---   field. For example:
---
--- >     , ppHidden          = xmobarColor "gray20" "" . wrap "<" ">"
--- >     , ppUrgent          = xmobarColor "dark orange" "" .  xmobarStrip
+-- | Strip xmobar markup.
 xmobarStrip :: String -> String
 xmobarStrip = strip [] where
     strip keep x
@@ -394,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)
@@ -451,32 +475,31 @@ defaultPP = PP { ppCurrent         = wrap "[" "]"
                , ppExtras          = []
                }
 
--- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in
--- ppUrgent.
+-- | 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" . dzenStrip
-                     , 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"
+                     , ppUrgent  = xmobarColor "red" "yellow"
                      }
 
 -- | The options that sjanssen likes to use with xmobar, as an
@@ -492,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
@@ -501,4 +524,3 @@ byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
   where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']
                                        then pad wsId
                                        else ""
-

XMonad/Hooks/EwmhDesktops.hs

@@ -19,7 +19,9 @@ module XMonad.Hooks.EwmhDesktops (
     ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
-    ewmhDesktopsEventHook
+    ewmhDesktopsEventHook,
+    ewmhDesktopsEventHookCustom,
+    fullscreenEventHook
     ) where
 
 import Codec.Binary.UTF8.String (encode)
@@ -32,7 +34,9 @@ import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import XMonad.Util.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
+import XMonad.Util.WindowProperties (getProp32)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -40,9 +44,10 @@ import XMonad.Util.WorkspaceCompare
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > main = xmonad $ ewmh defaultConfig
+-- > main = xmonad $ ewmh defaultConfig{ handleEventHook =
+-- >            handleEventHook defaultConfig <+> fullscreenEventHook }
 --
--- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks.
+-- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks".
 
 
 -- | Add EWMH functionality to the given config.  See above for an example.
@@ -113,18 +118,23 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
 --  * _NET_WM_DESKTOP (move windows to other desktops)
 --
 --  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
---
 ewmhDesktopsEventHook :: Event -> X All
-ewmhDesktopsEventHook e = handle e >> return (All True)
+ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
 
-handle :: Event -> X ()
-handle ClientMessageEvent {
+-- |
+-- Generalized version of ewmhDesktopsEventHook that allows an arbitrary
+-- user-specified function to transform the workspace list (post-sorting)
+ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
+ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
+
+handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
+handle f (ClientMessageEvent {
                ev_window = w,
                ev_message_type = mt,
                ev_data = d
-       } = withWindowSet $ \s -> do
+       }) = withWindowSet $ \s -> do
        sort' <- getSortByIndex
-       let ws = sort' $ W.workspaces s
+       let ws = f $ sort' $ W.workspaces s
 
        a_cd <- getAtom "_NET_CURRENT_DESKTOP"
        a_d <- getAtom "_NET_WM_DESKTOP"
@@ -132,14 +142,14 @@ 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
@@ -151,8 +161,40 @@ handle ClientMessageEvent {
           -- The Message is unknown to us, but that is ok, not all are meant
           -- to be handled by the window manager
           return ()
-handle _ = 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.
+--
+-- Note this is not included in 'ewmh'.
+fullscreenEventHook :: Event -> X All
+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+  wmstate <- getAtom "_NET_WM_STATE"
+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+  wstate <- fromMaybe [] `fmap` getProp32 wmstate 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 wmstate ptype propModeReplace (f wstate)
+
+  when (typ == wmstate && 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

XMonad/Hooks/FadeInactive.hs

@@ -17,10 +17,12 @@ module XMonad.Hooks.FadeInactive (
     -- $usage
     setOpacity,
     isUnfocused,
+    isUnfocusedOnCurrentWS,
     fadeIn,
     fadeOut,
     fadeIf,
     fadeInactiveLogHook,
+    fadeInactiveCurrentWSLogHook,
     fadeOutLogHook
     ) where
 
@@ -44,7 +46,7 @@ import Control.Monad
 -- 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"
 --
@@ -58,18 +60,18 @@ rationalToOpacity perc
     | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability
     | otherwise = round $ perc * 0xffffffff
 
--- | sets the opacity of a window
+-- | Sets the opacity of a window
 setOpacity :: Window -> Rational -> X ()
 setOpacity w t = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_WINDOW_OPACITY"
     c <- getAtom "CARDINAL"
     io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
--- | fades a window out by setting the opacity
+-- | 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 = fadeOut 1
 
@@ -78,15 +80,34 @@ fadeIn = fadeOut 1
 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
+-- | 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.
+-- | Set the opacity of inactive windows, on the current workspace, to the
+-- specified amount. This is specifically usefull in a multi monitor setup. See
+-- 'isUnfocusedOnCurrentWS'.
+fadeInactiveCurrentWSLogHook :: Rational -> X ()
+fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS
+
+-- | 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.
+-- | Returns True if the window doesn't have the focus, and the window is on the
+-- current workspace. This is specifically handy in a multi monitor setup
+-- (xinerama) where multiple workspaces are visible. Using this, non-focused
+-- workspaces are are not faded out making it easier to look and read the
+-- content on them.
+isUnfocusedOnCurrentWS :: Query Bool
+isUnfocusedOnCurrentWS = do
+  w <- ask
+  ws <- liftX $ gets windowset
+  let thisWS = w `elem` W.index ws
+      unfocused = maybe True (w /=) $ W.peek ws
+  return $ thisWS && unfocused
+
+-- | 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) ++

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

@@ -1,10 +1,11 @@
+{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.FloatNext
--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
--- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -35,40 +36,11 @@ module XMonad.Hooks.FloatNext ( -- * Usage
                               , willFloatAllNewPP
                               , runLogHook ) where
 
-import Prelude hiding (all)
-
 import XMonad
+import XMonad.Hooks.ToggleHook
 
-import Control.Monad (join)
-import Control.Applicative ((<$>))
-import Control.Arrow (first, second)
-import Control.Concurrent.MVar
-import System.IO.Unsafe (unsafePerformIO)
-
-
-{- Helper functions -}
-
-modifyMVar2 :: MVar a -> (a -> a) -> IO ()
-modifyMVar2 v f = modifyMVar_ v (return . f)
-
-_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
-_set f b = io $ modifyMVar2 floatModeMVar (f $ const b)
-
-_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
-_toggle f = io $ modifyMVar2 floatModeMVar (f not)
-
-_get :: ((Bool, Bool) -> a) -> X a
-_get f = io $ f <$> readMVar floatModeMVar
-
-_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
-_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing
-
-
-{- The current state is kept here -}
-
-floatModeMVar :: MVar (Bool, Bool)
-floatModeMVar = unsafePerformIO $ newMVar (False, False)
-
+hookName :: String
+hookName = "__float"
 
 -- $usage
 -- This module provides actions (that can be set as keybindings)
@@ -93,40 +65,34 @@ floatModeMVar = unsafePerformIO $ newMVar (False, False)
 --
 -- > , ((modm, xK_r), toggleFloatAllNew)
 
-
 -- | This 'ManageHook' will selectively float windows as set
 -- by 'floatNext' and 'floatAllNew'.
 floatNextHook :: ManageHook
-floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar
-                   io $ putMVar floatModeMVar (False, all)
-                   if next || all then doFloat else idHook
-
+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 = _set first
+floatNext = hookNext hookName
 
 toggleFloatNext :: X ()
-toggleFloatNext = _toggle first
+toggleFloatNext = toggleHookNext hookName
 
 -- | @floatAllNew True@ arranges for new windows to be
 -- sent to the floating layer, @floatAllNew False@ cancels it
 floatAllNew :: Bool -> X ()
-floatAllNew = _set second
+floatAllNew = hookAllNew hookName
 
 toggleFloatAllNew :: X ()
-toggleFloatAllNew = _toggle second
-
+toggleFloatAllNew = toggleHookAllNew hookName
 
 -- | Whether the next window will be set floating
 willFloatNext :: X Bool
-willFloatNext = _get fst
+willFloatNext = willHookNext hookName
 
 -- | Whether new windows will be set floating
 willFloatAllNew :: X Bool
-willFloatAllNew = _get snd
-
+willFloatAllNew = willHookAllNew hookName
 
 -- $pp
 -- The following functions are used to display the current
@@ -148,10 +114,7 @@ willFloatAllNew = _get snd
 -- pass them 'id'.
 
 willFloatNextPP :: (String -> String) -> X (Maybe String)
-willFloatNextPP = _pp fst "Next"
+willFloatNextPP = willHookNextPP hookName
 
 willFloatAllNewPP :: (String -> String) -> X (Maybe String)
-willFloatAllNewPP = _pp snd "All"
-
-runLogHook :: X ()
-runLogHook = join $ asks $ logHook . config
+willFloatAllNewPP = willHookAllNewPP hookName

XMonad/Hooks/ICCCMFocus.hs

@@ -0,0 +1,42 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-}
+(
+  atom_WM_TAKE_FOCUS
+, takeFocusX
+, takeTopFocus
+) where
+
+import XMonad
+import XMonad.Hooks.SetWMName
+import qualified XMonad.StackSet as W
+
+takeFocusX ::
+  Window
+  -> X ()
+takeFocusX _w = return ()
+
+-- | 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

@@ -46,7 +46,7 @@ data Focus = Newer | Older
 insertPosition :: Position -> Focus -> ManageHook
 insertPosition pos foc = Endo . g <$> ask
   where
-    g w = viewingWs w (updateFocus w . ins w . W.delete w)
+    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

XMonad/Hooks/ManageDocks.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
 -- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
 -----------------------------------------------------------------------------
 -- |
@@ -18,10 +17,17 @@ module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
     manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docksEventHook,
     ToggleStruts(..),
     SetStruts(..),
     module XMonad.Util.Types,
 
+#ifdef TESTING
+    r2c,
+    c2r,
+    RectC(..),
+#endif
+
     -- for XMonad.Actions.FloatSnap
     calcGap
     ) where
@@ -30,10 +36,11 @@ module XMonad.Hooks.ManageDocks (
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
-import Control.Monad
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types
 import XMonad.Util.WindowProperties (getProp32s)
+import XMonad.Util.XUtils (fi)
+import Data.Monoid (All(..))
 
 import qualified Data.Set as S
 
@@ -56,6 +63,11 @@ import qualified Data.Set as S
 -- > 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:
 --
@@ -99,8 +111,16 @@ checkDock = ask >>= \w -> liftX $ do
     desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
     mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
     case mbr of
-        Just [r] -> return $ elem (fromIntegral r) [dock, desk]
-        _        -> return False
+        Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)
+        _       -> 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]
@@ -210,41 +230,34 @@ 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,7 @@ module XMonad.Hooks.ManageHelpers (
     Side(..),
     composeOne,
     (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
+    currentWs,
     isInProperty,
     isKDETrayWindow,
     isFullscreen,
@@ -44,7 +45,8 @@ module XMonad.Hooks.ManageHelpers (
     doSideFloat,
     doFloatAt,
     doFloatDep,
-    doHideIgnore
+    doHideIgnore,
+    Match,
 ) where
 
 import XMonad
@@ -56,7 +58,7 @@ 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)
@@ -118,6 +120,10 @@ 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

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

@@ -1,10 +1,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.Place
--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
--- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -38,11 +38,12 @@ 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 (maybe, fromMaybe, catMaybes)
+import Data.Maybe (fromMaybe, catMaybes)
 import Data.Monoid (Endo(..))
 import Control.Monad (guard, join)
 import Control.Monad.Trans (lift)
@@ -262,8 +263,6 @@ checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2)
 scale :: (RealFrac a, Integral b) => a -> b -> b -> b
 scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1
 
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
 
 r2rr :: Rectangle -> Rectangle -> S.RationalRect
 r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)

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

@@ -8,9 +8,9 @@
 -- Stability   :  unstable
 -- Portability :  not portable
 --
--- Lets you restore minimized windows (see "XMonad.Layout.Minimize")
--- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
--- and WM_CHANGE_STATE).
+-- (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).
 --
 -----------------------------------------------------------------------------
 

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,9 +26,6 @@ module XMonad.Hooks.Script (
 --
 import XMonad
 
-import Control.Monad.Trans
-import System.Directory
-
 -- $usage
 --
 -- This module allows you to run a centrally located script with the text
@@ -48,7 +45,7 @@ import System.Directory
 
 -- | Execute a named script hook
 execScriptHook :: MonadIO m => String -> m ()
-execScriptHook hook = io $ do
-  home <- getHomeDirectory
-  let script = home ++ "/.xmonad/hooks "
+execScriptHook hook = do
+  xmonadDir <- getXMonadDir
+  let script = xmonadDir ++ "/hooks "
   spawn (script ++ hook)

XMonad/Hooks/ServerMode.hs

@@ -64,7 +64,6 @@ module XMonad.Hooks.ServerMode
     ) where
 
 import Control.Monad (when)
-import Data.List
 import Data.Monoid
 import System.IO
 

XMonad/Hooks/ToggleHook.hs

@@ -0,0 +1,170 @@
+{-# 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, Read, Show)
+
+instance ExtensionClass HookState where
+    initialValue = HookState empty
+    extensionType = PersistentExtension
+
+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 #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -58,30 +59,33 @@ module XMonad.Hooks.UrgencyHook (
                                  dzenUrgencyHook,
                                  DzenUrgencyHook(..),
                                  NoUrgencyHook(..),
+                                 BorderUrgencyHook(..),
                                  FocusHook(..),
                                  minutes, seconds,
                                  -- * Stuff for developers:
                                  readUrgents, withUrgents,
                                  StdoutUrgencyHook(..),
                                  SpawnUrgencyHook(..),
-                                 UrgencyHook(urgencyHook)
+                                 UrgencyHook(urgencyHook),
+                                 Interval,
+                                 borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook
                                  ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
 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)
+import System.IO (hPutStrLn, stderr)
 
 -- $usage
 --
@@ -195,7 +199,7 @@ 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 l
@@ -213,6 +217,15 @@ withUrgencyHookC hook urgConf conf = conf {
         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
@@ -262,25 +275,18 @@ focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMayb
 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
 
@@ -290,18 +296,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)
@@ -332,7 +339,7 @@ handleEvent wuh event =
                   callUrgencyHook wuh w
                 else
                   clearUrgency w
-              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
+              userCodeDef () =<< asks (logHook . config)
       DestroyWindowEvent {ev_window = w} ->
           clearUrgency w
       _ ->
@@ -369,7 +376,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
@@ -382,9 +391,12 @@ suppressibleWindows Never    = return []
 
 -- | The class definition, and some pre-defined instances.
 
-class (Read h, Show h) => UrgencyHook h where
+class UrgencyHook h where
     urgencyHook :: h -> Window -> X ()
 
+instance UrgencyHook (Window -> X ()) where
+    urgencyHook = id
+
 data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
 
 instance UrgencyHook NoUrgencyHook where
@@ -412,11 +424,40 @@ instance UrgencyHook DzenUrgencyHook where
 
   > withUrgencyHook FocusHook $ myconfig { ...
 -}
+focusHook :: Window -> X ()
+focusHook = urgencyHook FocusHook
 data FocusHook = FocusHook deriving (Read, Show)
 
 instance UrgencyHook FocusHook where
     urgencyHook _ _ = focusUrgent
 
+-- | A hook that sets the border color of an urgent window.  The color
+--   will remain until the next time the window gains or loses focus, at
+--   which point the standard border color from the XConfig will be applied.
+--   You may want to use suppressWhen = Never with this:
+--
+--   > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ...
+--
+--   (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration".
+--   @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt".  We need to
+--   think a bit more about namespacing issues, maybe.)
+
+borderUrgencyHook :: String -> Window -> X ()
+borderUrgencyHook = urgencyHook . BorderUrgencyHook
+data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
+                       deriving (Read, Show)
+
+instance UrgencyHook BorderUrgencyHook where
+  urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
+    withDisplay $ \dpy -> io $ do
+      c' <- initColor dpy cs
+      case c' of
+        Just c -> setWindowBorder dpy w c
+        _      -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
+                                            ,show cs
+                                            ," in BorderUrgencyHook"
+                                            ]
+
 -- | Flashes when a window requests your attention and you can't see it.
 -- Defaults to a duration of five seconds, and no extra args to dzen.
 -- See 'DzenUrgencyHook'.
@@ -426,12 +467,16 @@ dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }
 -- | Spawn a commandline thing, appending the window id to the prefix string
 -- you provide. (Make sure to add a space if you need it.) Do your crazy
 -- xcompmgr thing.
+spawnUrgencyHook :: String -> Window -> X ()
+spawnUrgencyHook = urgencyHook . SpawnUrgencyHook
 newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)
 
 instance UrgencyHook SpawnUrgencyHook where
     urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w
 
 -- | For debugging purposes, really.
+stdoutUrgencyHook :: Window -> X ()
+stdoutUrgencyHook = urgencyHook StdoutUrgencyHook
 data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
 
 instance UrgencyHook StdoutUrgencyHook where

XMonad/Hooks/XPropManage.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.XPropManage
@@ -17,14 +18,13 @@ module XMonad.Hooks.XPropManage (
                  xPropManageHook, XPropMatch, pmX, pmP
                  ) where
 
+import Control.Exception as E
 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@:
@@ -75,7 +75,7 @@ xPropManageHook tms = mconcat $ map propToHook tms
 
 getProp :: Display -> Window -> Atom -> X ([String])
 getProp d w p = do
-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
+    prop <- io $ E.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

@@ -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

@@ -18,7 +18,7 @@
 module XMonad.Layout.AutoMaster (
                              -- * Usage
                              -- $usage
-                             autoMaster
+                             autoMaster, AutoMaster
                             ) where
 import Control.Monad
 
@@ -48,7 +48,7 @@ import XMonad.Layout.LayoutModifier
 data AutoMaster a = AutoMaster Int Float Float
     deriving (Read,Show)
 
-instance LayoutModifier AutoMaster Window where
+instance (Eq w) => LayoutModifier AutoMaster w where
     modifyLayout (AutoMaster k bias _) = autoLayout k bias
     pureMess = autoMess
 
@@ -61,12 +61,12 @@ autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),
           resize Shrink = AutoMaster k (max (-0.4)  $ bias-delta) delta
 
 -- | Main layout function
-autoLayout :: (LayoutClass l Window) =>
+autoLayout :: (Eq w, LayoutClass l w) =>
               Int ->
               Float ->
-              W.Workspace WorkspaceId (l Window) Window
+              W.Workspace WorkspaceId (l w) w
               -> Rectangle
-              -> X ([(Window, Rectangle)], Maybe (l Window))
+              -> X ([(w, Rectangle)], Maybe (l w))
 autoLayout k bias wksp rect = do
     let stack = W.stack wksp
     let ws = W.integrate' stack

XMonad/Layout/BorderResize.hs

@@ -12,8 +12,10 @@
 -- This layout modifier will allow to resize windows by dragging their
 -- borders with the mouse. However, it only works in layouts or modified
 -- layouts that react to the 'SetGeometry' message.
--- "XMonad.Layout.WindowArranger" can be used to create such a setup.
--- BorderResize is probably most useful in floating layouts.
+-- "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.
 --
 -----------------------------------------------------------------------------
 
@@ -22,15 +24,15 @@ module XMonad.Layout.BorderResize
       -- $usage
       borderResize
     , BorderResize (..)
+    , RectWithBorders, BorderInfo,
     ) where
 
 import XMonad
 import XMonad.Layout.Decoration
 import XMonad.Layout.WindowArranger
 import XMonad.Util.XUtils
-import Control.Monad(when,forM)
-import Control.Arrow(first)
-import Control.Applicative((<$>))
+import Control.Monad(when)
+import qualified Data.Map as M
 
 -- $usage
 -- You can use this module with the following in your
@@ -41,89 +43,139 @@ import Control.Applicative((<$>))
 -- > main = xmonad defaultConfig { layoutHook = myLayout }
 --
 
-data BorderInfo = RightSideBorder Window Rectangle
-                    | LeftSideBorder Window Rectangle
-                    | TopSideBorder Window Rectangle
-                    | BottomSideBorder Window Rectangle
+type BorderBlueprint = (Rectangle, Glyph, BorderType)
+
+data BorderType = RightSideBorder
+                    | LeftSideBorder
+                    | TopSideBorder
+                    | BottomSideBorder
                     deriving (Show, Read, Eq)
-type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo)
-type BorderWithWin = (Window, BorderInfo)
+data BorderInfo = BI { bWin :: Window,
+                        bRect :: Rectangle,
+                        bType :: BorderType
+                     } deriving (Show, Read)
 
-data BorderResize a = BR [BorderWithWin] 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
-
-brCursorRightSide :: Glyph
-brCursorRightSide = 96
-brCursorLeftSide :: Glyph
-brCursorLeftSide = 70
-brCursorTopSide :: Glyph
-brCursorTopSide = 138
-brCursorBottomSide :: Glyph
-brCursorBottomSide = 16
+brBorderSize = 2
 
 borderResize :: l a -> ModifiedLayout BorderResize l a
-borderResize = ModifiedLayout (BR [])
+borderResize = ModifiedLayout (BR M.empty)
 
 instance LayoutModifier BorderResize Window where
     redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
-    redoLayout (BR borders) _ _ wrs = do
-        let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr)
-        mapM_ deleteBorder borders
-        newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) ->
-                        first (++[wr]) . unzip <$> mapM createBorder [b1,b2,b3,b4]
-        let wrs' = concat $ map fst newBorders
-            newBordersSerialized = concat $ map snd newBorders
-        return (wrs', Just $ BR newBordersSerialized)
+    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 borders) m
-        | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing
+    handleMess (BR wrsLastTime) m
+        | Just e <- fromMessage m :: Maybe Event =
+            handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing
         | Just _ <- fromMessage m :: Maybe LayoutMessages =
-            mapM_ deleteBorder borders >> return (Just $ BR [])
+            handleGone wrsLastTime >> return (Just $ BR M.empty)
     handleMess _ _ = return Nothing
 
-prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect)
-prepareBorders (w, r@(Rectangle x y wh ht)) =
-    ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide     , RightSideBorder w r),
-     (r, (Rectangle (x - brBorderOffset) y brBorderSize ht)         , brCursorLeftSide      , LeftSideBorder w r),
-     (r, (Rectangle x (y - brBorderOffset) wh brBorderSize)         , brCursorTopSide       , TopSideBorder w r),
-     (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide    , BottomSideBorder w r)
-    )
+compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
+compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder
+                                      in concat $ map compileWr wrs
 
-handleResize :: [BorderWithWin] -> Event -> X ()
+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 - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder),
+     ((Rectangle x y brBorderSize ht)                            , xC_left_side  , LeftSideBorder),
+     ((Rectangle x y wh brBorderSize)                            , xC_top_side   , TopSideBorder),
+     ((Rectangle x (y + fi ht - fi brBorderSize) 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) ->
+        (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) ->
+        (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) ->
+        (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 _) ->
+        (BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) ->
             mouseDrag (\_ y -> do
                             let nht = max 1 $ fi (y - hy)
                                 rect = Rectangle hx hy hwh nht
@@ -131,13 +183,10 @@ handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
                             when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
 handleResize _ _ = return ()
 
-createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin))
-createBorder (_, borderRect, borderCursor, borderInfo) = do
+createBorder :: BorderBlueprint -> X (BorderInfo)
+createBorder (borderRect, borderCursor, borderType) = do
     borderWin <- createInputWindow borderCursor borderRect
-    return ((borderWin, borderRect), (borderWin, borderInfo))
-
-deleteBorder :: BorderWithWin -> X ()
-deleteBorder (borderWin, _) = deleteWindow borderWin
+    return BI { bWin = borderWin, bRect = borderRect, bType = borderType }
 
 createInputWindow :: Glyph -> Rectangle -> X Window
 createInputWindow cursorGlyph r = withDisplay $ \d -> do
@@ -162,3 +211,13 @@ mkInputWindow d (Rectangle x y w h) = do
 
 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

@@ -6,7 +6,7 @@
 -- 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
 --
@@ -24,6 +24,10 @@ module XMonad.Layout.BoringWindows (
                                    UpdateBoring(UpdateBoring),
                                    BoringMessage(Replace,Merge),
                                    BoringWindows()
+
+                                   -- * Tips
+                                   -- ** variant of 'Full'
+                                   -- $simplest
                                   ) where
 
 import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
@@ -31,10 +35,8 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
 import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
               sendMessage, windows, withFocused, Window)
 import Control.Applicative((<$>))
-import Control.Monad(Monad(return, (>>)))
 import Data.List((\\), union)
-import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,
-                  maybeToList)
+import Data.Maybe(fromMaybe, listToMaybe, maybeToList)
 import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 
@@ -136,3 +138,12 @@ instance LayoutModifier BoringWindows Window where
 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

@@ -21,7 +21,8 @@ module XMonad.Layout.CenteredMaster (
          -- $usage
 
          centerMaster,
-         topRightMaster
+         topRightMaster,
+         CenteredMaster, TopRightMaster,
          ) where
 
 import XMonad

XMonad/Layout/Column.hs

@@ -61,9 +61,9 @@ columnLayout (Column q) rect stack = zip ws rects
 
 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 
+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/ComboP.hs

@@ -27,7 +27,7 @@ import Data.List ( delete, intersect, (\\) )
 import Data.Maybe ( isJust )
 import Control.Monad
 import XMonad hiding (focus)
-import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
+import XMonad.StackSet ( Workspace (..), Stack(..) )
 import XMonad.Layout.WindowNavigation
 import XMonad.Util.WindowProperties
 import qualified XMonad.StackSet as W

XMonad/Layout/Decoration.hs

@@ -2,7 +2,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Decoration
--- Copyright   :  (c) 2007 Andrea Rossato
+-- Copyright   :  (c) 2007 Andrea Rossato, 2009 Jan Vornberger
 -- License     :  BSD-style (see xmonad/LICENSE)
 --
 -- Maintainer  :  andrea.rossato@unibz.it
@@ -27,11 +27,13 @@ module XMonad.Layout.Decoration
     , isInStack, isVisible, isInvisible, isWithin, fi
     , findWindowByDecoration
     , module XMonad.Layout.LayoutModifier
+    , DecorationState, OrigWin
     ) where
 
 import Control.Monad (when)
 import Data.Maybe
 import Data.List
+import Foreign.C.Types(CInt)
 
 import XMonad
 import qualified XMonad.StackSet as W
@@ -42,6 +44,7 @@ import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Invisible
 import XMonad.Util.XUtils
 import XMonad.Util.Font
+import XMonad.Util.Image
 
 -- $usage
 -- This module is intended for layout developers, who want to decorate
@@ -65,18 +68,22 @@ decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)
 --
 -- For a collection of 'Theme's see "XMonad.Util.Themes"
 data Theme =
-    Theme { activeColor         :: String    -- ^ Color of the active window
-          , inactiveColor       :: String    -- ^ Color of the inactive window
-          , urgentColor         :: String    -- ^ Color of the urgent window
-          , activeBorderColor   :: String    -- ^ Color of the border of the active window
-          , inactiveBorderColor :: String    -- ^ Color of the border of the inactive window
-          , urgentBorderColor   :: String    -- ^ Color of the border of the urgent window
-          , activeTextColor     :: String    -- ^ Color of the text of the active window
-          , inactiveTextColor   :: String    -- ^ Color of the text of the inactive window
-          , urgentTextColor     :: String    -- ^ Color of the text of the urgent window
-          , fontName            :: String    -- ^ Font name
-          , decoWidth           :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
-          , decoHeight          :: Dimension -- ^ Height of the decorations
+    Theme { activeColor        :: String                   -- ^ Color of the active window
+          , inactiveColor       :: String                   -- ^ Color of the inactive window
+          , urgentColor         :: String                   -- ^ Color of the urgent window
+          , activeBorderColor   :: String                   -- ^ Color of the border of the active window
+          , inactiveBorderColor :: String                   -- ^ Color of the border of the inactive window
+          , urgentBorderColor   :: String                   -- ^ Color of the border of the urgent window
+          , activeTextColor     :: String                   -- ^ Color of the text of the active window
+          , inactiveTextColor   :: String                   -- ^ Color of the text of the inactive window
+          , urgentTextColor     :: String                   -- ^ Color of the text of the urgent window
+          , fontName            :: String                   -- ^ Font name
+          , decoWidth           :: Dimension                -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
+          , decoHeight          :: Dimension                -- ^ Height of the decorations
+          , windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.
+                                                           --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"
+          , windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.
+                                                           --    Inner @[Bool]@ is a row in a icon bitmap.
           } deriving (Show, Read)
 
 -- | The default xmonad 'Theme'.
@@ -94,6 +101,8 @@ defaultTheme =
           , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
           , decoWidth           = 200
           , decoHeight          = 20
+          , windowTitleAddons   = []
+          , windowTitleIcons    = []
           }
 
 -- | A 'Decoration' layout modifier will handle 'SetTheme', a message
@@ -136,30 +145,36 @@ class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where
     shrink :: ds a -> Rectangle -> Rectangle -> Rectangle
     shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh)
 
-    -- | The decoration event hook, where the
-    -- 'decorationMouseFocusHook' and 'decorationMouseDragHook' are
-    -- called. If you reimplement it those methods will not be
-    -- called.
+    -- | The decoration event hook
     decorationEventHook :: ds a -> DecorationState -> Event -> X ()
-    decorationEventHook ds s e = do decorationMouseFocusHook  ds s e
-                                    decorationMouseDragHook   ds s e
+    decorationEventHook ds s e = handleMouseFocusDrag ds s e
 
-    -- | This method is called when the user clicks the pointer over
-    -- the decoration.
-    decorationMouseFocusHook :: ds a -> DecorationState -> Event -> X ()
-    decorationMouseFocusHook _ s e = handleMouseFocusDrag False s e
+    -- | A hook that can be used to catch the cases when the user
+    -- clicks on the decoration. If you return True here, the click event
+    -- will be considered as dealt with and no further processing will take place.
+    decorationCatchClicksHook :: ds a
+                              -> Window
+                              -> Int    -- ^ distance from the left where the click happened on the decoration
+                              -> Int    -- ^ distance from the right where the click happened on the decoration
+                              -> X Bool
+    decorationCatchClicksHook _ _ _ _ = return False
 
-    -- | This method is called when the user starts grabbing the
-    -- decoration.
-    decorationMouseDragHook :: ds a -> DecorationState -> Event -> X ()
-    decorationMouseDragHook _ s e = handleMouseFocusDrag True s e
+    -- | This hook is called while a window is dragged using the decoration.
+    -- The hook can be overwritten if a different way of handling the dragging
+    -- is required.
+    decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y
+
+    -- | This hoook is called after a window has been dragged using the decoration.
+    decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()
+    decorationAfterDraggingHook _ds (mainw, _r) _decoWin = focus mainw
 
     -- | The pure version of the main method, 'decorate'.
     pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle
                    -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle
-    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh _) = if isInStack s w
-                                                         then Just $ Rectangle x y wh ht
-                                                         else Nothing
+    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht')
+                                                             then Just $ Rectangle x y wh ht
+                                                             else Nothing
 
     -- | Given the theme's decoration width and height, the screen
     -- rectangle, the windows stack, the list of windows and
@@ -283,22 +298,30 @@ handleEvent _ _ _ _ = return ()
 
 -- | Mouse focus and mouse drag are handled by the same function, this
 -- way we can start dragging unfocused windows too.
-handleMouseFocusDrag :: Bool -> DecorationState -> Event -> X ()
-handleMouseFocusDrag b (DS dwrs _) ButtonEvent { ev_window     = ew
-                                               , ev_event_type = et
-                                               , ev_x_root     = ex
-                                               , ev_y_root     = ey }
+handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X ()
+handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window     = ew
+                                                , ev_event_type = et
+                                                , ev_x_root     = ex
+                                                , ev_y_root     = ey }
     | et == buttonPress
-    , Just ((mainw,r),_) <- lookFor ew dwrs = do
-                              focus mainw
-                              when b $ mouseDrag (\x y -> do
-                                                    let rect = Rectangle (x - (fi ex - rect_x r))
-                                                                         (y - (fi ey - rect_y r))
-                                                                         (rect_width  r)
-                                                                         (rect_height r)
-                                                    sendMessage (SetGeometry rect)) (return ())
+    , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do
+        let Just (Rectangle dx _ dwh _) = decoRectM
+            distFromLeft = ex - fi dx
+            distFromRight = fi dwh - (ex - fi dx)
+        dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
+        when (not dealtWith) $ do
+            mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)
+                        (decorationAfterDraggingHook ds (mainw, r) ew)
 handleMouseFocusDrag _ _ _ = return ()
 
+handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()
+handleDraggingInProgress ex ey (_, r) x y = do
+    let rect = Rectangle (x - (fi ex - rect_x r))
+                         (y - (fi ey - rect_y r))
+                         (rect_width  r)
+                         (rect_height r)
+    sendMessage $ SetGeometry rect
+
 -- | Given a window and the state, if a matching decoration is in the
 -- state return it with its ('Maybe') 'Rectangle'.
 lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))
@@ -345,7 +368,7 @@ createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in
                        createNewWindow r mask (inactiveColor t) True
 
 showDecos :: [DecoWin] -> X ()
-showDecos = showWindows . catMaybes . map fst
+showDecos = showWindows . catMaybes . map fst . filter (isJust . snd)
 
 hideDecos :: [DecoWin] -> X ()
 hideDecos = hideWindows . catMaybes . map fst
@@ -374,7 +397,11 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
   let s = shrinkIt sh
   name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
                                   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
-  paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name
+  let als = AlignCenter : map snd (windowTitleAddons t)
+      strs = name : map fst (windowTitleAddons t)
+      i_als = map snd (windowTitleIcons t)
+      icons = map fst (windowTitleIcons t)
+  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons
 updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
 updateDeco _ _ _ _ = return ()
 

XMonad/Layout/DecorationAddons.hs

@@ -0,0 +1,123 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DecorationAddons
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Various stuff that can be added to the decoration. Most of it
+-- is intended to be used by other modules. See
+-- "XMonad.Layout.ButtonDecoration" for a module that makes use of this.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DecorationAddons (
+                                    titleBarButtonHandler
+                                   ,defaultThemeWithButtons
+                                   ,handleScreenCrossing
+                                   ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.Decoration
+import XMonad.Actions.WindowMenu
+import XMonad.Layout.Minimize
+import XMonad.Layout.Maximize
+import XMonad.Hooks.ManageDocks
+import XMonad.Util.Font
+import XMonad.Util.PositionStore
+
+import Control.Applicative((<$>))
+import Data.Maybe
+import qualified Data.Set as S
+
+minimizeButtonOffset :: Int
+minimizeButtonOffset = 48
+
+maximizeButtonOffset :: Int
+maximizeButtonOffset = 25
+
+closeButtonOffset :: Int
+closeButtonOffset = 10
+
+buttonSize :: Int
+buttonSize = 10
+
+-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.
+-- It will intercept clicks on the buttons of the decoration and invoke the associated action.
+-- To actually see the buttons, you will need to use a theme that includes them.
+-- See 'defaultThemeWithButtons' below.
+titleBarButtonHandler :: Window -> Int -> Int -> X Bool
+titleBarButtonHandler mainw distFromLeft distFromRight = do
+    let action = if (fi distFromLeft <= 3 * buttonSize)
+                        then focus mainw >> windowMenu >> return True
+                  else if (fi distFromRight >= closeButtonOffset &&
+                           fi distFromRight <= closeButtonOffset + buttonSize)
+                              then focus mainw >> kill >> return True
+                  else if (fi distFromRight >= maximizeButtonOffset &&
+                           fi distFromRight <= maximizeButtonOffset + (2 * buttonSize))
+                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True
+                  else if (fi distFromRight >= minimizeButtonOffset &&
+                           fi distFromRight <= minimizeButtonOffset + buttonSize)
+                             then focus mainw >> minimizeWindow mainw >> return True
+                  else return False
+    action
+
+-- | Intended to be used together with 'titleBarButtonHandler'. See above.
+defaultThemeWithButtons :: Theme
+defaultThemeWithButtons = defaultTheme {
+                            windowTitleAddons = [ (" (M)", AlignLeft)
+                                                , ("_"   , AlignRightOffset minimizeButtonOffset)
+                                                , ("[]"  , AlignRightOffset maximizeButtonOffset)
+                                                , ("X"   , AlignRightOffset closeButtonOffset)
+                                                ]
+                            }
+
+-- | A function intended to be plugged into the 'decorationAfterDraggingHook' of a decoration.
+-- It will check if the window has been dragged onto another screen and shift it there.
+-- The PositionStore is also updated accordingly, as this is designed to be used together
+-- with "XMonad.Layout.PositionStoreFloat".
+handleScreenCrossing :: Window -> Window -> X Bool
+handleScreenCrossing w decoWin = withDisplay $ \d -> do
+    root <- asks theRoot
+    (_, _, _, px, py, _, _, _) <- io $ queryPointer d root
+    ws <- gets windowset
+    sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py)
+    maybeWksp <- screenWorkspace $ W.screen sc
+    let targetWksp = maybeWksp >>= \wksp ->
+                        W.findTag w ws >>= \currentWksp ->
+                        if (currentWksp /= wksp)
+                            then Just wksp
+                            else Nothing
+    case targetWksp of
+        Just wksp -> do
+                        -- find out window under cursor on target workspace
+                        -- apparently we have to switch to the workspace first
+                        -- to make this work, which unforunately introduces some flicker
+                        windows $ \ws' -> W.view wksp ws'
+                        (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root
+
+                        -- adjust PositionStore
+                        let oldScreenRect = screenRect . W.screenDetail $ W.current ws
+                            newScreenRect = screenRect . W.screenDetail $ sc
+                        {-- somewhat ugly hack to get proper ScreenRect,
+                            creates unwanted inter-dependencies
+                            TODO: get ScreenRects in a proper way --}
+                        oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound])
+                        newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound])
+                        wa <- io $ getWindowAttributes d decoWin
+                        modifyPosStore (\ps ->
+                            posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa)
+                                oldScreenRect' newScreenRect')
+
+                        -- set focus correctly so the window will be inserted
+                        -- at the correct position on the target workspace
+                        -- and then shift the window
+                        windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws'
+
+                        -- return True to signal that screen crossing has taken place
+                        return True
+        Nothing -> return False

XMonad/Layout/DecorationMadness.hs

@@ -94,7 +94,6 @@ import XMonad.Layout.TabBarDecoration
 
 import XMonad.Layout.Accordion
 import XMonad.Layout.Circle
-import XMonad.Layout.ResizeScreen
 import XMonad.Layout.WindowArranger
 import XMonad.Layout.SimpleFloat
 

XMonad/Layout/Dishes.hs

@@ -21,7 +21,6 @@ module XMonad.Layout.Dishes (
                               Dishes (..)
                             ) where
 
-import Data.List
 import XMonad
 import XMonad.StackSet (integrate)
 import Control.Monad (ap)

XMonad/Layout/DraggingVisualizer.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveDataTypeable, TypeSynonymInstances, MultiParamTypeClasses, FlexibleContexts #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DraggingVisualizer
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A helper module to visualize the process of dragging a window by
+-- making it follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration"
+-- for a module that makes use of this.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DraggingVisualizer
+    ( draggingVisualizer,
+      DraggingVisualizerMsg (..),
+      DraggingVisualizer,
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+
+data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )
+draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window
+draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing
+
+data DraggingVisualizerMsg = DraggingWindow Window Rectangle
+                                | DraggingStopped
+                                deriving ( Typeable, Eq )
+instance Message DraggingVisualizerMsg
+
+instance LayoutModifier DraggingVisualizer Window where
+    modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"
+    pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =
+            if draggedWin `elem` (map fst wrs)
+                then (dragged : rest, Nothing)
+                else (wrs, Just $ DraggingVisualizer Nothing)
+        where
+            rest = filter (\(w, _) -> w /= draggedWin) wrs
+    pureModifier _ _ _ wrs = (wrs, Nothing)
+
+    pureMess (DraggingVisualizer _) m = case fromMessage m of
+        Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)
+        Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing
+        _ -> Nothing

XMonad/Layout/Drawer.hs

@@ -0,0 +1,131 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, FlexibleContexts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Drawer
+-- Copyright   :  (c) 2009 Max Rabkin
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  max.rabkin@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier that puts some windows in a "drawer" which retracts and
+-- expands depending on whether any window in it has focus.
+--
+-- Useful for music players, tool palettes, etc.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Drawer
+    ( -- * Usage
+      -- $usage
+
+      -- * Drawers
+      simpleDrawer
+    , drawer
+
+      -- * Placing drawers
+      -- The drawer can be placed on any side of the screen with these functions
+    , onLeft, onTop, onRight, onBottom
+
+    , module XMonad.Util.WindowProperties
+
+    , Drawer, Reflected
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.WindowProperties
+import XMonad.StackSet as S
+import XMonad.Layout.Reflect
+
+-- $usage
+-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Drawer
+--
+-- > myLayout = drawer `onTop` (Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout...
+-- >     where
+-- >         drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat")
+-- >
+-- > main = xmonad defaultConfig { layoutHook = myLayout }
+--
+-- This will place the Rhythmbox and Xchat windows in at the top of the screen
+-- only when using the 'Tall' layout.  See "XMonad.Util.WindowProperties" for
+-- more information on selecting windows.
+
+data Drawer l a = Drawer Rational Rational Property (l a)
+    deriving (Read, Show)
+
+-- | filter : filterM :: partition : partitionM
+partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
+partitionM _ [] = return ([], [])
+partitionM f (x:xs) = do
+    b <- f x
+    (ys, zs) <- partitionM f xs
+    return $ if b
+                then (x:ys, zs)
+                else (ys, x:zs)
+
+instance (LayoutClass l Window, Read (l Window)) => LayoutModifier (Drawer l) Window where
+    modifyLayout (Drawer rs rb p l) ws rect =
+        case stack ws of
+            Nothing -> runLayout ws rect
+            Just stk@(Stack { up=up_, down=down_, S.focus=w }) -> do
+                    (upD, upM) <- partitionM (hasProperty p) up_
+                    (downD, downM) <- partitionM (hasProperty p) down_
+                    b <- hasProperty p w
+                    focusedWindow <- gets (fmap S.focus . stack . workspace . current . windowset)
+
+                    let rectD = if b && Just w == focusedWindow then rectB else rectS
+
+                    let (stackD, stackM) = if b
+                                            then ( Just $ stk { up=upD, down=downD }
+                                                 , mkStack upM downM )
+                                            else ( mkStack upD downD
+                                                 , Just $ stk { up=upM, down=downM } )
+
+                    (winsD, _) <- runLayout (ws { layout=l, stack=stackD }) rectD
+                    (winsM, u') <- runLayout (ws { stack=stackM }) rectM
+                    return (winsD ++ winsM, u')
+      where
+        mkStack [] [] = Nothing
+        mkStack xs (y:ys) = Just (Stack { up=xs, S.focus=y, down=ys })
+        mkStack (x:xs) ys = Just (Stack { up=xs, S.focus=x, down=ys })
+
+        rectB = rect { rect_width=round $ fromIntegral (rect_width rect) * rb }
+        rectS = rectB { rect_x=rect_x rectB - (round $ (rb - rs) * fromIntegral (rect_width rect)) }
+        rectM = rect { rect_x=rect_x rect + round (fromIntegral (rect_width rect) * rs)
+                     , rect_width=rect_width rect - round (fromIntegral (rect_width rect) * rs) }
+
+type Reflected l = ModifiedLayout Reflect l
+
+-- | Construct a drawer with a simple layout of the windows inside
+simpleDrawer :: Rational -- ^ The portion of the screen taken up by the drawer when closed
+              -> Rational   -- ^ The portion of the screen taken up by the drawer when open
+              -> Property   -- ^ Which windows to put in the drawer
+              -> Drawer Tall a
+simpleDrawer rs rb p = Drawer rs rb p vertical
+    where
+        vertical = Tall 0 0 0
+
+-- Export a synonym for the constructor as a Haddock workaround
+-- | Construct a drawer with an arbitrary layout for windows inside
+drawer ::    Rational   -- ^ The portion of the screen taken up by the drawer when closed
+          -> Rational   -- ^ The portion of the screen taken up by the drawer when open
+          -> Property   -- ^ Which windows to put in the drawer
+          -> (l a)      -- ^ The layout of windows in the drawer
+          -> Drawer l a
+drawer = Drawer
+
+onLeft :: Drawer l a -> l' a -> ModifiedLayout (Drawer l) l' a
+onLeft = ModifiedLayout
+
+onRight :: Drawer l a -> l' a -> Reflected (ModifiedLayout (Drawer l) (Reflected l')) a
+onRight d = reflectHoriz . onLeft d . reflectHoriz
+
+onTop :: Drawer l a -> l' a -> Mirror (ModifiedLayout (Drawer l) (Mirror l')) a
+onTop d = Mirror . onLeft d . Mirror
+
+onBottom :: Drawer l a -> l' a -> Reflected (Mirror (ModifiedLayout (Drawer l) (Mirror (Reflected l')))) a
+onBottom d = reflectVert . onTop d . reflectVert

XMonad/Layout/Fullscreen.hs

@@ -0,0 +1,227 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Decoration
+-- Copyright   :  (c) 2010 Audun Skaugen
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  audunskaugen@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Hooks for sending messages about fullscreen windows to layouts, and
+-- a few example layout modifier that implement fullscreen windows.
+-----------------------------------------------------------------------------
+module XMonad.Layout.Fullscreen
+    ( -- * Usage:
+      -- $usage
+     fullscreenFull
+    ,fullscreenFocus
+    ,fullscreenFullRect
+    ,fullscreenFocusRect
+    ,fullscreenFloat
+    ,fullscreenFloatRect
+    ,fullscreenEventHook
+    ,fullscreenManageHook
+    ,fullscreenManageHookWith
+    ,FullscreenMessage(..)
+     -- * Types for reference
+    ,FullscreenFloat, FullscreenFocus, FullscreenFull
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.WindowProperties
+import XMonad.Hooks.ManageHelpers (isFullscreen)
+import qualified XMonad.StackSet as W
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Map as M
+import Control.Monad
+import Control.Arrow (second)
+
+-- $usage
+-- Provides a ManageHook and an EventHook that sends layout messages
+-- with information about fullscreening windows. This allows layouts
+-- to make their own decisions about what they should to with a
+-- window that requests fullscreen.
+--
+-- The module also includes a few layout modifiers as an illustration
+-- of how such layouts should behave.
+--
+-- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook'
+-- to your config, i.e.
+--
+-- > xmonad defaultconfig { handleEventHook = fullscreenEventHook,
+-- >                        manageHook = fullscreenManageHook,
+-- >                        layoutHook = myLayouts }
+--
+-- Now you can use layouts that respect fullscreen, for example the
+-- provided 'fullscreenFull':
+--
+-- > myLayouts = fullscreenFull someLayout
+--
+
+-- | Messages that control the fullscreen state of the window.
+-- AddFullscreen and RemoveFullscreen are sent to all layouts
+-- when a window wants or no longer wants to be fullscreen.
+-- FullscreenChanged is sent to the current layout after one
+-- of the above have been sent.
+data FullscreenMessage = AddFullscreen Window
+                       | RemoveFullscreen Window
+                       | FullscreenChanged
+     deriving (Typeable)
+
+instance Message FullscreenMessage
+
+data FullscreenFull a = FullscreenFull W.RationalRect [a]
+     deriving (Read, Show)
+
+data FullscreenFocus a = FullscreenFocus W.RationalRect [a]
+     deriving (Read, Show)
+
+data FullscreenFloat a = FullscreenFloat W.RationalRect (M.Map a (W.RationalRect, Bool))
+     deriving (Read, Show)
+
+instance LayoutModifier FullscreenFull Window where
+  pureMess ff@(FullscreenFull frect fulls) m = case fromMessage m of
+    Just (AddFullscreen win) -> Just $ FullscreenFull frect $ nub $ win:fulls
+    Just (RemoveFullscreen win) -> Just $ FullscreenFull frect $ delete win $ fulls
+    Just FullscreenChanged -> Just ff
+    _ -> Nothing
+
+  pureModifier (FullscreenFull frect fulls) rect _ list =
+    (map (flip (,) rect') visfulls ++ rest, Nothing)
+    where visfulls = intersect fulls $ map fst list
+          rest = filter (flip notElem visfulls . fst) list
+          rect' = scaleRationalRect rect frect
+
+instance LayoutModifier FullscreenFocus Window where
+  pureMess ff@(FullscreenFocus frect fulls) m = case fromMessage m of
+    Just (AddFullscreen win) -> Just $ FullscreenFocus frect $ nub $ win:fulls
+    Just (RemoveFullscreen win) -> Just $ FullscreenFocus frect $ delete win $ fulls
+    Just FullscreenChanged -> Just ff
+    _ -> Nothing
+
+  pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
+     | f `elem` fulls = ((f, rect') : rest, Nothing)
+     | otherwise = (list, Nothing)
+     where rest = filter ((/= f) . fst) list
+           rect' = scaleRationalRect rect frect
+  pureModifier _ _ Nothing list = (list, Nothing)
+
+instance LayoutModifier FullscreenFloat Window where
+  handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
+    Just (AddFullscreen win) -> do
+      mrect <- (M.lookup win . W.floating) `fmap` gets windowset
+      return $ case mrect of
+        Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
+        Nothing -> Nothing
+
+    Just (RemoveFullscreen win) ->
+      return $ Just $ FullscreenFloat frect $ M.adjust (second $ const False) win fulls
+
+    -- Modify the floating member of the stack set directly; this is the hackish part.
+    Just FullscreenChanged -> do
+      st <- get
+      let ws = windowset st
+          flt = W.floating ws
+          flt' = M.intersectionWith doFull fulls flt
+      put st {windowset = ws {W.floating = M.union flt' flt}}
+      return $ Just $ FullscreenFloat frect $ M.filter snd fulls
+      where doFull (_, True) _ = frect
+            doFull (rect, False) _ = rect
+
+    Nothing -> return Nothing
+
+-- | Layout modifier that makes fullscreened window fill the
+-- entire screen.
+fullscreenFull :: LayoutClass l a =>
+  l a -> ModifiedLayout FullscreenFull l a
+fullscreenFull = fullscreenFullRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFullRect :: LayoutClass l a =>
+  W.RationalRect -> l a -> ModifiedLayout FullscreenFull l a
+fullscreenFullRect r = ModifiedLayout $ FullscreenFull r []
+
+-- | Layout modifier that makes the fullscreened window fill
+-- the entire screen only if it is currently focused.
+fullscreenFocus :: LayoutClass l a =>
+  l a -> ModifiedLayout FullscreenFocus l a
+fullscreenFocus = fullscreenFocusRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFocusRect :: LayoutClass l a =>
+  W.RationalRect -> l a -> ModifiedLayout FullscreenFocus l a
+fullscreenFocusRect r = ModifiedLayout $ FullscreenFocus r []
+
+-- | Hackish layout modifier that makes floating fullscreened
+-- windows fill the entire screen.
+fullscreenFloat :: LayoutClass l a =>
+  l a -> ModifiedLayout FullscreenFloat l a
+fullscreenFloat = fullscreenFloatRect $ W.RationalRect 0 0 1 1
+
+-- | As above, but the fullscreened window will fill the
+-- specified rectangle instead of the entire screen.
+fullscreenFloatRect :: LayoutClass l a =>
+  W.RationalRect -> l a -> ModifiedLayout FullscreenFloat l a
+fullscreenFloatRect r = ModifiedLayout $ FullscreenFloat r M.empty
+
+-- | The event hook required for the layout modifiers to work
+fullscreenEventHook :: Event -> X All
+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+  wmstate <- getAtom "_NET_WM_STATE"
+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+  wstate <- fromMaybe [] `fmap` getProp32 wmstate win
+  let fi :: (Integral i, Num n) => i -> n
+      fi = fromIntegral
+      isFull = fi fullsc `elem` wstate
+      remove = 0
+      add = 1
+      toggle = 2
+      ptype = 4
+      chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
+  when (typ == wmstate && fi fullsc `elem` dats) $ do
+    when (action == add || (action == toggle && not isFull)) $ do
+      chWState (fi fullsc:)
+      broadcastMessage $ AddFullscreen win
+      sendMessage FullscreenChanged
+    when (action == remove || (action == toggle && isFull)) $ do
+      chWState $ delete (fi fullsc)
+      broadcastMessage $ RemoveFullscreen win
+      sendMessage FullscreenChanged
+  return $ All True
+
+fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
+  -- When a window is destroyed, the layouts should remove that window
+  -- from their states.
+  broadcastMessage $ RemoveFullscreen w
+  cw <- (W.workspace . W.current) `fmap` gets windowset
+  sendMessageWithNoRefresh FullscreenChanged cw
+  return $ All True
+
+fullscreenEventHook _ = return $ All True
+
+-- | Manage hook that sets the fullscreen property for
+-- windows that are initially fullscreen
+fullscreenManageHook :: ManageHook
+fullscreenManageHook = fullscreenManageHook' isFullscreen
+
+-- | A version of fullscreenManageHook that lets you specify
+-- your own query to decide whether a window should be fullscreen.
+fullscreenManageHookWith :: Query Bool -> ManageHook
+fullscreenManageHookWith h = fullscreenManageHook' $ isFullscreen <||> h
+
+fullscreenManageHook' :: Query Bool -> ManageHook
+fullscreenManageHook' isFull = isFull --> do
+  w <- ask
+  liftX $ do
+    broadcastMessage $ AddFullscreen w
+    cw <- (W.workspace . W.current) `fmap` gets windowset
+    sendMessageWithNoRefresh FullscreenChanged cw
+  idHook
+

XMonad/Layout/Gaps.hs

@@ -28,7 +28,7 @@
 module XMonad.Layout.Gaps (
                                -- * Usage
                                -- $usage
-                          Direction2D(..),
+                          Direction2D(..), Gaps,
                           GapSpec, gaps, GapMessage(..)
 
                           ) where
@@ -38,6 +38,7 @@ import Graphics.X11 (Rectangle(..))
 
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types (Direction2D(..))
+import XMonad.Util.XUtils (fi)
 
 import Data.List (delete)
 
@@ -56,8 +57,8 @@ import Data.List (delete)
 --
 -- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps)  -- toggle all gaps
 -- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
--- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap R 5)  -- increment the right-hand gap
--- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap R 5)  -- decrement the right-hand gap
+-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R)  -- increment the right-hand gap
+-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R)  -- decrement the right-hand gap
 --
 -- If you want complete control over all gaps, you could include
 -- something like this in your keybindings, assuming in this case you
@@ -133,9 +134,6 @@ toggleGap conf cur d | d `elem` cur            = delete d cur
 incGap :: GapSpec -> Direction2D -> Int -> GapSpec
 incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
 
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral
-
 -- | Add togglable manual gaps to a layout.
 gaps :: GapSpec   -- ^ The gaps to allow, paired with their initial sizes.
      -> l a       -- ^ The layout to modify.

XMonad/Layout/GridVariants.hs

@@ -19,7 +19,8 @@
 
 module XMonad.Layout.GridVariants ( -- * Usage
                                     -- $usage
-                                    ChangeMasterGeom(..)
+                                    ChangeMasterGridGeom(..)
+                                  , ChangeGridGeom(..)
                                   , Grid(..)
                                   , TallGrid(..)
                                   , SplitGrid(..)
@@ -68,9 +69,24 @@ instance LayoutClass Grid a where
           nwins = length wins
           rects = arrangeAspectGrid rect nwins aspect
 
+    pureMessage layout msg = fmap (changeGridAspect layout) (fromMessage msg)
+
     description _ = "Grid"
 
--- | SplitGrid layout.  Parameters are
+changeGridAspect :: Grid a -> ChangeGridGeom -> Grid a
+changeGridAspect (Grid _) (SetGridAspect aspect) = Grid aspect
+changeGridAspect (Grid aspect) (ChangeGridAspect delta) =
+    Grid (max 0.00001 (aspect + delta))
+
+-- |Geometry change messages understood by Grid and SplitGrid
+data ChangeGridGeom
+    = SetGridAspect !Rational
+    | ChangeGridAspect !Rational
+      deriving Typeable
+
+instance Message ChangeGridGeom
+
+-- |SplitGrid layout.  Parameters are
 --
 --   - side where the master is
 --   - number of master rows
@@ -81,8 +97,8 @@ instance LayoutClass Grid a where
 data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational
                    deriving (Read, Show)
 
--- | Type to specify the side of the screen that holds
---   the master area of a SplitGrid.
+-- |Type to specify the side of the screen that holds
+--  the master area of a SplitGrid.
 data Orientation = T | B | L | R
                    deriving (Eq, Read, Show)
 
@@ -95,18 +111,23 @@ instance LayoutClass SplitGrid a where
           rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect
 
     pureMessage layout msg =
-        msum [ fmap (resizeMaster layout) (fromMessage msg)
-             , fmap (changeMasterGrid layout) (fromMessage msg) ]
+        msum [ fmap (resizeMaster layout)          (fromMessage msg)
+             , fmap (changeMasterGrid layout)      (fromMessage msg)
+             , fmap (changeSlaveGridAspect layout) (fromMessage msg)
+             ]
 
     description _ = "SplitGrid"
 
 -- |The geometry change message understood by the master grid
-data ChangeMasterGeom
-    = IncMasterRows !Int -- ^Change the number of master rows
-    | IncMasterCols !Int -- ^Change the number of master columns
+data ChangeMasterGridGeom
+    = IncMasterRows     !Int      -- ^Change the number of master rows
+    | IncMasterCols     !Int      -- ^Change the number of master columns
+    | SetMasterRows     !Int      -- ^Set the number of master rows to absolute value
+    | SetMasterCols     !Int      -- ^Set the number of master columns to absolute value
+    | SetMasterFraction !Rational -- ^Set the fraction of the screen used by the master grid
     deriving Typeable
 
-instance Message ChangeMasterGeom
+instance Message ChangeMasterGridGeom
 
 arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle]
 arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect
@@ -183,11 +204,23 @@ resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink =
 resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand =
     SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta
 
-changeMasterGrid :: SplitGrid a -> ChangeMasterGeom -> SplitGrid a
+changeMasterGrid :: SplitGrid a -> ChangeMasterGridGeom -> SplitGrid a
 changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) =
     SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta
 changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) =
     SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta
+changeMasterGrid (SplitGrid o _ mcols mfrac saspect delta) (SetMasterRows mrows) =
+    SplitGrid o (max 0 mrows) mcols mfrac saspect delta
+changeMasterGrid (SplitGrid o mrows _ mfrac saspect delta) (SetMasterCols mcols) =
+    SplitGrid o mrows (max 0 mcols) mfrac saspect delta
+changeMasterGrid (SplitGrid o mrows mcols _ saspect delta) (SetMasterFraction mfrac) =
+    SplitGrid o mrows mcols mfrac saspect delta
+
+changeSlaveGridAspect :: SplitGrid a -> ChangeGridGeom -> SplitGrid a
+changeSlaveGridAspect (SplitGrid o mrows mcols mfrac _ delta) (SetGridAspect saspect) =
+    SplitGrid o mrows mcols mfrac saspect delta
+changeSlaveGridAspect (SplitGrid o mrows mcols mfrac saspect delta) (ChangeGridAspect sdelta) =
+    SplitGrid o mrows mcols mfrac (max 0.00001 (saspect + sdelta)) delta
 
 -- | TallGrid layout.  Parameters are
 --

XMonad/Layout/Groups.hs

@@ -0,0 +1,510 @@
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
+{-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable
+  , UndecidableInstances, FlexibleInstances, MultiParamTypeClasses
+  , PatternGuards, Rank2Types, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Groups
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Two-level layout with windows split in individual layout groups,
+-- themselves managed by a user-provided layout.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Groups ( -- * Usage
+                              -- $usage
+                              -- * Creation
+                              group
+                              -- * Messages
+                            , GroupsMessage(..)
+                            , ModifySpec
+                              -- ** Useful 'ModifySpec's
+                            , swapUp
+                            , swapDown
+                            , swapMaster
+                            , focusUp
+                            , focusDown
+                            , focusMaster
+                            , swapGroupUp
+                            , swapGroupDown
+                            , swapGroupMaster
+                            , focusGroupUp
+                            , focusGroupDown
+                            , focusGroupMaster
+                            , moveToGroupUp
+                            , moveToGroupDown
+                            , moveToNewGroupUp
+                            , moveToNewGroupDown
+                            , splitGroup
+                              -- * Types
+                            , Groups
+                            , Group(..)
+                            , onZipper
+                            , onLayout
+                            , WithID
+                            , sameID
+                            ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Util.Stack
+
+import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)
+import Data.List ((\\))
+import Control.Arrow ((>>>))
+import Control.Applicative ((<$>))
+import Control.Monad (forM)
+
+-- $usage
+-- This module provides a layout combinator that allows you
+-- to manage your windows in independent groups. You can provide
+-- both the layout with which to arrange the windows inside each
+-- group, and the layout with which the groups themselves will
+-- be arranged on the screen.
+--
+-- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii"
+-- modules contain examples of layouts that can be defined with this
+-- combinator. They're also the recommended starting point
+-- if you are a beginner and looking for something you can use easily.
+--
+-- One thing to note is that 'Groups'-based layout have their own
+-- notion of the order of windows, which is completely separate
+-- from XMonad's. For this reason, operations like 'XMonad.StackSet.SwapUp'
+-- will have no visible effect, and those like 'XMonad.StackSet.focusUp'
+-- will focus the windows in an unpredictable order. For a better way of
+-- rearranging windows and moving focus in such a layout, see the
+-- example 'ModifySpec's (to be passed to the 'Modify' message) provided
+-- by this module.
+--
+-- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers"
+-- module provides actions that can work correctly with both, defined using
+-- functions from "XMonad.Actions.MessageFeedback".
+
+-- | Create a 'Groups' layout.
+--
+-- Note that the second parameter (the layout for arranging the
+-- groups) is not used on 'Windows', but on 'Group's. For this
+-- reason, you can only use layouts that don't specifically
+-- need to manage 'Window's. This is obvious, when you think
+-- about it.
+group :: l Window -> l2 (Group l Window) -> Groups l l2 Window
+group l l2 = Groups l l2 startingGroups (U 1 0)
+    where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ
+
+
+-- * Stuff with unique keys
+
+data Uniq = U Integer Integer
+  deriving (Eq, Show, Read)
+
+-- | From a seed, generate an infinite list of keys and a new
+-- seed. All keys generated with this method will be different
+-- provided you don't use 'gen' again with a key from the list.
+-- (if you need to do that, see 'split' instead)
+gen :: Uniq -> (Uniq, [Uniq])
+gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..])
+
+-- | Split an infinite list into two. I ended up not
+-- needing this, but let's keep it just in case.
+-- split :: [a] -> ([a], [a])
+-- split as = snd $ foldr step (True, ([], [])) as
+--     where step a (True, (as1, as2)) = (False, (a:as1, as2))
+--           step a (False, (as1, as2)) = (True, (as1, a:as2))
+
+-- | Add a unique identity to a layout so we can
+-- follow it around.
+data WithID l a = ID { getID :: Uniq
+                     , unID :: (l a)}
+  deriving (Show, Read)
+
+-- | Compare the ids of two 'WithID' values
+sameID :: WithID l a -> WithID l a -> Bool
+sameID (ID id1 _) (ID id2 _) = id1 == id2
+
+instance Eq (WithID l a) where
+    ID id1 _ == ID id2 _ = id1 == id2
+
+instance LayoutClass l a => LayoutClass (WithID l) a where
+    runLayout ws@W.Workspace { W.layout = ID id l } r
+        = do (placements, ml') <- flip runLayout r
+                                     ws { W.layout = l}
+             return (placements, ID id <$> ml')
+    handleMessage (ID id l) sm = do ml' <- handleMessage l sm
+                                    return $ ID id <$> ml'
+    description (ID _ l) = description l
+
+
+
+-- * The 'Groups' layout
+
+
+-- ** Datatypes
+
+-- | A group of windows and its layout algorithm.
+data Group l a = G { gLayout :: WithID l a
+                   , gZipper :: Zipper a }
+  deriving (Show, Read, Eq)
+
+onLayout :: (WithID l a -> WithID l a) -> Group l a -> Group l a
+onLayout f g = g { gLayout = f $ gLayout g }
+
+onZipper :: (Zipper a -> Zipper a) -> Group l a -> Group l a
+onZipper f g = g { gZipper = f $ gZipper g }
+
+-- | The type of our layouts.
+data Groups l l2 a = Groups { -- | The starting layout for new groups
+                              baseLayout :: l a
+                              -- | The layout for placing each group on the screen
+                            , partitioner :: l2 (Group l a)
+                              -- | The window groups
+                            , groups :: W.Stack (Group l a)
+                              -- | A seed for generating unique ids
+                            , seed :: Uniq
+                            }
+
+deriving instance (Show a, Show (l a), Show (l2 (Group l a))) => Show (Groups l l2 a)
+deriving instance (Read a, Read (l a), Read (l2 (Group l a))) => Read (Groups l l2 a)
+
+-- | Messages accepted by 'Groups'-based layouts.
+-- All other messages are forwarded to the layout of the currently
+-- focused subgroup (as if they had been wrapped in 'ToFocused').
+data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosing layout
+                                             -- (the one that places the groups themselves)
+                   | ToGroup Int SomeMessage -- ^ Send a message to the layout for nth group
+                                             -- (starting at 0)
+                   | ToFocused SomeMessage -- ^ Send a message to the layout for the focused
+                                           -- group
+                   | ToAll SomeMessage -- ^ Send a message to all the sub-layouts
+                   | Refocus -- ^ Refocus the window which should be focused according
+                             -- to the layout.
+                   | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing
+                                       -- of windows according to a 'ModifySpec'
+                     deriving Typeable
+
+instance Show GroupsMessage where
+    show (ToEnclosing _) = "ToEnclosing {...}"
+    show (ToGroup i _) = "ToGroup "++show i++" {...}"
+    show (ToFocused _) = "ToFocused {...}"
+    show (ToAll _) = "ToAll {...}"
+    show Refocus = "Refocus"
+    show (Modify _) = "Modify {...}"
+
+instance Message GroupsMessage
+
+modifyGroups :: (Zipper (Group l a) -> Zipper (Group l a))
+             -> Groups l l2 a -> Groups l l2 a
+modifyGroups f g = let (seed', id:_) = gen (seed g)
+                       defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
+                   in g { groups = fromMaybe defaultGroups . f . Just $ groups g
+                        , seed = seed' }
+
+
+-- ** Readaptation
+
+-- | Adapt our groups to a new stack.
+-- This algorithm handles window additions and deletions correctly,
+-- ignores changes in window ordering, and tries to react to any
+-- other stack changes as gracefully as possible.
+readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a
+readapt z g = let mf = getFocusZ z
+                  (seed', id:_) = gen $ seed g
+                  g' = g { seed = seed' }
+              in flip modifyGroups g' $ mapZ_ (onZipper $ removeDeleted z)
+                                        >>> filterKeepLast (isJust . gZipper)
+                                        >>> findNewWindows (W.integrate' z)
+                                        >>> addWindows (ID id $ baseLayout g)
+                                        >>> focusGroup mf
+                                        >>> onFocusedZ (onZipper $ focusWindow mf)
+    where filterKeepLast _ Nothing = Nothing
+          filterKeepLast f z@(Just s) = maybe (singletonZ $ W.focus s) Just
+                                            $ filterZ_ f z
+
+-- | Remove the windows from a group which are no longer present in
+-- the stack.
+removeDeleted :: Eq a => Zipper a -> Zipper a -> Zipper a
+removeDeleted z = filterZ_ (flip elemZ z)
+
+-- | Identify the windows not already in a group.
+findNewWindows :: Eq a => [a] -> Zipper (Group l a)
+               -> (Zipper (Group l a), [a])
+findNewWindows as gs = (gs, foldrZ_ removePresent as gs)
+    where removePresent g as' = filter (not . flip elemZ (gZipper g)) as'
+
+-- | Add windows to the focused group. If you need to create one,
+-- use the given layout and an id from the given list.
+addWindows :: WithID l a -> (Zipper (Group l a), [a]) -> Zipper (Group l a)
+addWindows l (Nothing, as) = singletonZ $ G l (W.differentiate as)
+addWindows _ (z, as) = onFocusedZ (onZipper add) z
+    where add z = foldl (flip insertUpZ) z as
+
+-- | Focus the group containing the given window
+focusGroup :: Eq a => Maybe a -> Zipper (Group l a) -> Zipper (Group l a)
+focusGroup Nothing = id
+focusGroup (Just a) = fromTags . map (tagBy $ elemZ a . gZipper) . W.integrate'
+
+-- | Focus the given window
+focusWindow :: Eq a => Maybe a -> Zipper a -> Zipper a
+focusWindow Nothing = id
+focusWindow (Just a) = fromTags . map (tagBy (==a)) . W.integrate'
+
+
+-- * Interface
+
+-- ** Layout instance
+
+instance (LayoutClass l Window, LayoutClass l2 (Group l Window))
+    => LayoutClass (Groups l l2) Window where
+
+        description (Groups _ p gs _) = s1++" by "++s2
+            where s1 = description $ gLayout $ W.focus gs
+                  s2 = description p
+
+        runLayout ws@(W.Workspace _ _l z) r = let l = readapt z _l in
+            do (areas, mpart') <- runLayout ws { W.layout = partitioner l
+                                               , W.stack = Just $ groups l } r
+
+               results <- forM areas $ \(g, r') -> runLayout ws { W.layout = gLayout g
+                                                                , W.stack = gZipper g } r'
+
+               let hidden = map gLayout (W.integrate $ groups l) \\ map (gLayout . fst) areas
+               hidden' <- mapM (flip handleMessage $ SomeMessage Hide) hidden
+
+               let placements = concatMap fst results
+                   newL = justMakeNew l mpart' (map snd results ++ hidden')
+
+               return $ (placements, newL)
+
+        handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm
+            = do mp' <- handleMessage p sm'
+                 return $ maybeMakeNew l mp' []
+
+        handleMessage l@(Groups _ p gs _) sm | Just (ToAll sm') <- fromMessage sm
+            = do mp' <- handleMessage p sm'
+                 mg's <- mapZM_ (handle sm') $ Just gs
+                 return $ maybeMakeNew l mp' $ W.integrate' mg's
+            where handle sm (G l _) = handleMessage l sm
+
+        handleMessage l sm | Just a <- fromMessage sm
+            = let _rightType = a == Hide -- Is there a better-looking way
+                                         -- of doing this?
+              in handleMessage l $ SomeMessage $ ToAll sm
+
+        handleMessage l@(Groups _ _ z _) sm = case fromMessage sm of
+              Just (ToFocused sm') -> do mg's <- W.integrate' <$> handleOnFocused sm' z
+                                         return $ maybeMakeNew l Nothing mg's
+              Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z
+                                         return $ maybeMakeNew l Nothing mg's
+              Just (Modify spec) -> case applySpec spec l of
+                                      Just l' -> refocus l' >> return (Just l')
+                                      Nothing -> return $ Just l
+              Just Refocus -> refocus l >> return (Just l)
+              Just _ -> return Nothing
+              Nothing -> handleMessage l $ SomeMessage (ToFocused sm)
+            where handleOnFocused sm z = mapZM step $ Just z
+                      where step True (G l _) = handleMessage l sm
+                            step False _ = return Nothing
+                  handleOnIndex i sm z = mapM step $ zip [0..] $ W.integrate z
+                      where step (j, (G l _)) | i == j = handleMessage l sm
+                            step _ = return Nothing
+
+
+justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
+            -> Maybe (Groups l l2 a)
+justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart'
+                                   , groups = combine (groups g) ml's }
+    where combine z ml's = let table = map (\(ID id a) -> (id, a)) $ catMaybes ml's
+                           in flip mapS_ z $ \(G (ID id l) ws) -> case lookup id table of
+                                        Nothing -> G (ID id l) ws
+                                        Just l' -> G (ID id l') ws
+          mapS_ f = fromJust . mapZ_ f . Just
+
+
+maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
+             -> Maybe (Groups l l2 a)
+maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing
+maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's
+
+refocus :: Groups l l2 Window -> X ()
+refocus g = case getFocusZ $ gZipper $ W.focus $ groups g
+            of Just w -> focus w
+               Nothing -> return ()
+
+-- ** ModifySpec type
+
+-- | Type of functions describing modifications to a 'Groups' layout. They
+-- are transformations on 'Zipper's of groups.
+--
+-- Things you shouldn't do:
+--
+-- * Forge new windows (they will be ignored)
+--
+-- * Duplicate windows (whatever happens is your problem)
+--
+-- * Remove windows (they will be added again)
+--
+-- * Duplicate layouts (only one will be kept, the rest will
+--   get the base layout)
+--
+-- Note that 'ModifySpec' is a rank-2 type (indicating that 'ModifySpec's must
+-- be polymorphic in the layout type), so if you define functions taking
+-- 'ModifySpec's as arguments, or returning them,  you'll need to write a type
+-- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning
+type ModifySpec = forall l. WithID l Window
+                -> Zipper (Group l Window)
+                -> Zipper (Group l Window)
+
+-- | Apply a ModifySpec.
+applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
+applySpec f g = let (seed', id:ids) = gen $ seed g
+                    g' = flip modifyGroups g $ f (ID id $ baseLayout g)
+                                               >>> toTags
+                                               >>> foldr reID ((ids, []), [])
+                                               >>> snd
+                                               >>> fromTags
+                in case groups g == groups g' of
+                     True -> Nothing
+                     False -> Just g' { seed = seed' }
+
+    where reID eg ((id:ids, seen), egs)
+              = let myID = getID $ gLayout $ fromE eg
+                in case elem myID seen of
+                     False -> ((id:ids, myID:seen), eg:egs)
+                     True -> ((ids, seen), mapE_ (setID id) eg:egs)
+              where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
+          reID _ (([], _), _) = undefined -- The list of ids is infinite
+
+
+
+
+
+-- ** Misc. ModifySpecs
+
+-- | helper
+onFocused :: (Zipper Window -> Zipper Window) -> ModifySpec
+onFocused f _ gs = onFocusedZ (onZipper f) gs
+
+-- | Swap the focused window with the previous one.
+swapUp :: ModifySpec
+swapUp = onFocused swapUpZ
+
+-- | Swap the focused window with the next one.
+swapDown :: ModifySpec
+swapDown = onFocused swapDownZ
+
+-- | Swap the focused window with the (group's) master
+-- window.
+swapMaster :: ModifySpec
+swapMaster = onFocused swapMasterZ
+
+-- | Swap the focused group with the previous one.
+swapGroupUp :: ModifySpec
+swapGroupUp _ = swapUpZ
+
+-- | Swap the focused group with the next one.
+swapGroupDown :: ModifySpec
+swapGroupDown _ = swapDownZ
+
+-- | Swap the focused group with the master group.
+swapGroupMaster :: ModifySpec
+swapGroupMaster _ = swapMasterZ
+
+-- | Move focus to the previous window in the group.
+focusUp :: ModifySpec
+focusUp = onFocused focusUpZ
+
+-- | Move focus to the next window in the group.
+focusDown :: ModifySpec
+focusDown = onFocused focusDownZ
+
+-- | Move focus to the group's master window.
+focusMaster :: ModifySpec
+focusMaster = onFocused focusMasterZ
+
+-- | Move focus to the previous group.
+focusGroupUp :: ModifySpec
+focusGroupUp _ = focusUpZ
+
+-- | Move focus to the next group.
+focusGroupDown :: ModifySpec
+focusGroupDown _ = focusDownZ
+
+-- | Move focus to the master group.
+focusGroupMaster :: ModifySpec
+focusGroupMaster _ = focusMasterZ
+
+-- | helper
+_removeFocused :: W.Stack a -> (a, Zipper a)
+_removeFocused (W.Stack f (u:up) down) = (f, Just $ W.Stack u up down)
+_removeFocused (W.Stack f [] (d:down)) = (f, Just $ W.Stack d [] down)
+_removeFocused (W.Stack f [] []) = (f, Nothing)
+
+-- helper
+_moveToNewGroup :: WithID l Window -> W.Stack (Group l Window)
+                -> (Group l Window -> Zipper (Group l Window)
+                                   -> Zipper (Group l Window))
+                -> Zipper (Group l Window)
+_moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s
+    = let (w, f') = _removeFocused f
+          s' = s { W.focus = G l f' }
+      in insertX (G l0 $ singletonZ w) $ Just s'
+_moveToNewGroup _ s _ = Just s
+
+-- | Move the focused window to a new group before the current one.
+moveToNewGroupUp :: ModifySpec
+moveToNewGroupUp _ Nothing = Nothing
+moveToNewGroupUp l0 (Just s) = _moveToNewGroup l0 s insertUpZ
+
+-- | Move the focused window to a new group after the current one.
+moveToNewGroupDown :: ModifySpec
+moveToNewGroupDown _ Nothing = Nothing
+moveToNewGroupDown l0 (Just s) = _moveToNewGroup l0 s insertDownZ
+
+
+-- | Move the focused window to the previous group.
+-- If 'True', when in the first group, wrap around to the last one.
+-- If 'False', create a new group before it.
+moveToGroupUp :: Bool -> ModifySpec
+moveToGroupUp _ _ Nothing = Nothing
+moveToGroupUp False l0 (Just s) = if null (W.up s) then moveToNewGroupUp l0 (Just s)
+                                                   else moveToGroupUp True l0 (Just s)
+moveToGroupUp True _ (Just s@(W.Stack _ [] [])) = Just s
+moveToGroupUp True _ (Just s@(W.Stack (G l (Just f)) _ _))
+    = let (w, f') = _removeFocused f
+      in onFocusedZ (onZipper $ insertUpZ w) $ focusUpZ $ Just s { W.focus = G l f' }
+moveToGroupUp True _ gs = gs
+
+-- | Move the focused window to the next group.
+-- If 'True', when in the last group, wrap around to the first one.
+-- If 'False', create a new group after it.
+moveToGroupDown :: Bool -> ModifySpec
+moveToGroupDown _ _ Nothing = Nothing
+moveToGroupDown False l0 (Just s) = if null (W.down s) then moveToNewGroupDown l0 (Just s)
+                                                       else moveToGroupDown True l0 (Just s)
+moveToGroupDown True _ (Just s@(W.Stack _ [] [])) = Just s
+moveToGroupDown True _ (Just s@(W.Stack (G l (Just f)) _ _))
+    = let (w, f') = _removeFocused f
+      in onFocusedZ (onZipper $ insertUpZ w) $ focusDownZ $ Just s { W.focus = G l f' }
+moveToGroupDown True _ gs = gs
+
+-- | Split the focused group into two at the position of the focused window (below it,
+-- unless it's the last window - in that case, above it).
+splitGroup :: ModifySpec
+splitGroup _ Nothing = Nothing
+splitGroup l0 z@(Just s) | G l (Just ws) <- W.focus s
+    = case ws of
+        W.Stack _ [] [] -> z
+        W.Stack f (u:up) [] -> let g1 = G l  $ Just $ W.Stack f [] []
+                                   g2 = G l0 $ Just $ W.Stack u up []
+                               in insertDownZ g1 $ onFocusedZ (const g2) z
+        W.Stack f up (d:down) -> let g1 = G l  $ Just $ W.Stack f up []
+                                     g2 = G l0 $ Just $ W.Stack d [] down
+                                 in insertUpZ g1 $ onFocusedZ (const g2) z
+splitGroup _ _ = Nothing

XMonad/Layout/Groups/Examples.hs

@@ -0,0 +1,240 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Groups.Examples
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Example layouts for "XMonad.Layout.Groups".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Groups.Examples ( -- * Usage
+                                       -- $usage
+
+                                       -- * Example: Row of columns
+                                       -- $example1
+                                       rowOfColumns
+                                     , zoomColumnIn
+                                     , zoomColumnOut
+                                     , zoomColumnReset
+                                     , toggleColumnFull
+                                     , zoomWindowIn
+                                     , zoomWindowOut
+                                     , zoomWindowReset
+                                     , toggleWindowFull
+
+                                       -- * Example: Tiled tab groups
+                                       -- $example2
+                                     , tallTabs
+                                     , mirrorTallTabs
+                                     , fullTabs
+                                     , TiledTabsConfig(..)
+                                     , defaultTiledTabsConfig
+                                     , increaseNMasterGroups
+                                     , decreaseNMasterGroups
+                                     , shrinkMasterGroups
+                                     , expandMasterGroups
+                                     , nextOuterLayout
+
+
+                                       -- * Useful re-exports and utils
+                                     , module XMonad.Layout.Groups.Helpers
+                                     , shrinkText
+                                     , defaultTheme
+                                     , GroupEQ(..)
+                                     , zoomRowG
+                                     ) where
+
+import XMonad hiding ((|||))
+
+import qualified XMonad.Layout.Groups as G
+import XMonad.Layout.Groups.Helpers
+
+import XMonad.Layout.ZoomRow
+import XMonad.Layout.Tabbed
+import XMonad.Layout.Named
+import XMonad.Layout.Renamed
+import XMonad.Layout.LayoutCombinators
+import XMonad.Layout.Decoration
+import XMonad.Layout.Simplest
+
+
+-- $usage
+-- This module contains example 'G.Groups'-based layouts.
+-- You can either import this module directly, or look at its source
+-- for ideas of how "XMonad.Layout.Groups" may be used.
+--
+-- You can use the contents of this module by adding
+--
+-- > import XMonad.Layout.Groups.Examples
+--
+-- to the top of your @.\/.xmonad\/xmonad.hs@.
+--
+-- For more information on using any of the layouts, jump directly
+--   to its \"Example\" section.
+--
+-- Whichever layout you choose to use, you will probably want to be
+--   able to move focus and windows between groups in a consistent
+--   manner. For this, you should take a look at the functions from
+--   the "XMonad.Layout.Groups.Helpers" module, which are all
+--   re-exported by this module.
+--
+-- For more information on how to extend your layour hook and key bindings, see
+--   "XMonad.Doc.Extending".
+
+
+-- * Helper: ZoomRow of Group elements
+
+-- | Compare two 'Group's by comparing the ids of their layouts.
+data GroupEQ a = GroupEQ
+  deriving (Show, Read)
+
+instance Eq a => EQF GroupEQ (G.Group l a) where
+    eq _ (G.G l1 _) (G.G l2 _) = G.sameID l1 l2
+
+zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a))
+            => ZoomRow GroupEQ (G.Group l a)
+zoomRowG = zoomRowWith GroupEQ
+
+
+-- * Example 1: Row of columns
+
+-- $example1
+-- A layout that arranges windows in a row of columns. It uses 'ZoomRow's for
+-- both, allowing you to:
+--
+--  * Freely change the proportion of the screen width allocated to each column
+--
+--  * Freely change the proportion of a column's heigth allocated to each of its windows
+--
+--  * Set a column to occupy the whole screen space whenever it has focus
+--
+--  * Set a window to occupy its whole column whenever it has focus
+--
+-- to use this layout, add 'rowOfColumns' to your layout hook, for example:
+--
+-- > myLayout = rowOfColumns
+--
+-- To be able to change the sizes of columns and windows, you can create key bindings
+-- for the relevant actions:
+--
+-- > ((modMask, xK_minus), zoomWindowOut)
+--
+-- and so on.
+
+rowOfColumns = G.group column zoomRowG
+    where column = renamed [CutWordsLeft 2, PrependWords "ZoomColumn"] $ Mirror zoomRow
+
+-- | Increase the width of the focused column
+zoomColumnIn :: X ()
+zoomColumnIn = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomIn
+
+-- | Decrease the width of the focused column
+zoomColumnOut :: X ()
+zoomColumnOut = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomOut
+
+-- | Reset the width of the focused column
+zoomColumnReset :: X ()
+zoomColumnReset = sendMessage $ G.ToEnclosing $ SomeMessage $ zoomReset
+
+-- | Toggle whether the currently focused column should
+-- take up all available space whenever it has focus
+toggleColumnFull :: X ()
+toggleColumnFull = sendMessage $ G.ToEnclosing $ SomeMessage $ ZoomFullToggle
+
+-- | Increase the heigth of the focused window
+zoomWindowIn :: X ()
+zoomWindowIn = sendMessage zoomIn
+
+-- | Decrease the height of the focused window
+zoomWindowOut :: X ()
+zoomWindowOut = sendMessage zoomOut
+
+-- | Reset the height of the focused window
+zoomWindowReset :: X ()
+zoomWindowReset = sendMessage zoomReset
+
+-- | Toggle whether the currently focused window should
+-- take up the whole column whenever it has focus
+toggleWindowFull :: X ()
+toggleWindowFull = sendMessage ZoomFullToggle
+
+
+-- * Example 2: Tabbed groups in a Tall/Full layout.
+
+-- $example2
+-- A layout which arranges windows into tabbed groups, and the groups
+-- themselves according to XMonad's default algorithm
+-- (@'Tall' ||| 'Mirror' 'Tall' ||| 'Full'@). As their names
+-- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts
+-- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any
+-- case you can freely switch between the three afterwards.
+--
+-- You can use any of these three layouts by including it in your layout hook.
+-- You will need to provide it with a 'TiledTabsConfig' containing the size
+-- parameters for 'Tall' and 'Mirror' 'Tall', and the shrinker and decoration theme
+-- for the tabs. If you're happy with defaults, you can use 'defaultTiledTabsConfig':
+--
+-- > myLayout = tallTabs defaultTiledTabsConfig
+--
+-- To be able to increase\/decrease the number of master groups and shrink\/expand
+-- the master area, you can create key bindings for the relevant actions:
+--
+-- > ((modMask, xK_h), shrinkMasterGroups)
+--
+-- and so on.
+
+-- | Configuration data for the "tiled tab groups" layout
+data TiledTabsConfig s = TTC { vNMaster :: Int
+                             , vRatio :: Rational
+                             , vIncrement :: Rational
+                             , hNMaster :: Int
+                             , hRatio :: Rational
+                             , hIncrement :: Rational
+                             , tabsShrinker :: s
+                             , tabsTheme :: Theme }
+
+defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker
+defaultTiledTabsConfig = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText defaultTheme
+
+fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c
+
+tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full
+
+mirrorTallTabs c = _tab c $ G.group _tabs $ _horiz c ||| Full ||| _vert c
+
+_tabs = named "Tabs" Simplest
+
+_tab c l = renamed [CutWordsLeft 1] $ addTabs (tabsShrinker c) (tabsTheme c) l
+
+_vert c = named "Vertical" $ Tall (vNMaster c) (vIncrement c) (vRatio c)
+
+_horiz c = named "Horizontal" $ Mirror $ Tall (hNMaster c) (hIncrement c) (hRatio c)
+
+-- | Increase the number of master groups by one
+increaseNMasterGroups :: X ()
+increaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN 1
+
+-- | Decrease the number of master groups by one
+decreaseNMasterGroups :: X ()
+decreaseNMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ IncMasterN (-1)
+
+-- | Shrink the master area
+shrinkMasterGroups :: X ()
+shrinkMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Shrink
+
+-- | Expand the master area
+expandMasterGroups :: X ()
+expandMasterGroups = sendMessage $ G.ToEnclosing $ SomeMessage $ Expand
+
+-- | Rotate the available outer layout algorithms
+nextOuterLayout :: X ()
+nextOuterLayout = sendMessage $ G.ToEnclosing $ SomeMessage $ NextLayout
+

XMonad/Layout/Groups/Helpers.hs

@@ -0,0 +1,232 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Groups.Helpers
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Utility functions for "XMonad.Layout.Groups".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Groups.Helpers ( -- * Usage
+                                      -- $usage
+
+                                      -- ** Layout-generic actions
+                                      swapUp
+                                    , swapDown
+                                    , swapMaster
+                                    , focusUp
+                                    , focusDown
+                                    , focusMaster
+                                    , toggleFocusFloat
+
+                                      -- ** 'G.Groups'-secific actions
+                                    , swapGroupUp
+                                    , swapGroupDown
+                                    , swapGroupMaster
+                                    , focusGroupUp
+                                    , focusGroupDown
+                                    , focusGroupMaster
+                                    , moveToGroupUp
+                                    , moveToGroupDown
+                                    , moveToNewGroupUp
+                                    , moveToNewGroupDown
+                                    , splitGroup ) where
+
+import XMonad hiding ((|||))
+import qualified XMonad.StackSet as W
+
+import qualified XMonad.Layout.Groups as G
+
+import XMonad.Actions.MessageFeedback
+
+import Control.Monad (unless)
+import qualified Data.Map as M
+
+-- $usage
+--
+-- This module provides helpers functions for use with "XMonad.Layout.Groups"-based
+-- layouts. You can use its contents by adding
+--
+-- > import XMonad.Layout.Groups.Helpers
+--
+-- to the top of your @.\/.xmonad\/xmonad.hs@.
+--
+-- "XMonad.Layout.Groups"-based layouts do not have the same notion
+-- of window ordering as the rest of XMonad. For this reason, the usual
+-- ways of reordering windows and moving focus do not work with them.
+-- "XMonad.Layout.Groups" provides 'Message's that can be used to obtain
+-- the right effect.
+--
+-- But what if you want to use both 'G.Groups' and other layouts?
+-- This module provides actions that try to send 'G.GroupsMessage's, and
+-- fall back to the classic way if the current layout doesn't hande them.
+-- They are in the section called \"Layout-generic actions\".
+--
+-- The sections \"Groups-specific actions\" contains actions that don't make
+-- sense for non-'G.Groups'-based layouts. These are simply wrappers around
+-- the equivalent 'G.GroupsMessage's, but are included so you don't have to
+-- write @sendMessage $ Modify $ ...@ everytime.
+--
+-- This module exports many operations with the same names as
+-- 'G.ModifySpec's from "XMonad.Layout.Groups", so if you want
+-- to import both, we suggest to import "XMonad.Layout.Groups"
+-- qualified:
+--
+-- > import qualified XMonad.Layout.Groups as G
+--
+-- For more information on how to extend your layour hook and key bindings, see
+-- "XMonad.Doc.Extending".
+
+-- ** Layout-generic actions
+-- #Layout-generic actions#
+
+alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()
+alt f g = alt2 (G.Modify f) $ windows g
+
+alt2 :: G.GroupsMessage -> X () -> X ()
+alt2 m x = do b <- send m
+              unless b x
+
+-- | Swap the focused window with the previous one
+swapUp :: X ()
+swapUp = alt G.swapUp W.swapUp
+
+-- | Swap the focused window with the next one
+swapDown :: X ()
+swapDown = alt G.swapDown W.swapDown
+
+-- | Swap the focused window with the master window
+swapMaster :: X ()
+swapMaster = alt G.swapMaster W.swapMaster
+
+-- | If the focused window is floating, focus the next floating
+-- window. otherwise, focus the next non-floating one.
+focusUp :: X ()
+focusUp = ifFloat focusFloatUp focusNonFloatUp
+
+-- | If the focused window is floating, focus the next floating
+-- window. otherwise, focus the next non-floating one.
+focusDown :: X ()
+focusDown = ifFloat focusFloatDown focusNonFloatDown
+
+-- | Move focus to the master window
+focusMaster :: X ()
+focusMaster = alt G.focusMaster W.shiftMaster
+
+-- | Move focus between the floating and non-floating layers
+toggleFocusFloat :: X ()
+toggleFocusFloat = ifFloat focusNonFloat focusFloatUp
+
+-- *** Floating layer helpers
+
+getFloats :: X [Window]
+getFloats = gets $ M.keys . W.floating . windowset
+
+getWindows :: X [Window]
+getWindows = gets $ W.integrate' . W.stack . W.workspace . W.current . windowset
+
+ifFloat :: X () -> X () -> X ()
+ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats
+                                       if elem w floats then x1 else x2
+
+focusNonFloat :: X ()
+focusNonFloat = alt2 G.Refocus helper
+    where helper = withFocused $ \w -> do
+                     ws <- getWindows
+                     floats <- getFloats
+                     let (before,  after) = span (/=w) ws
+                     case filter (flip notElem floats) $ after ++ before of
+                       [] -> return ()
+                       w':_ -> focus w'
+
+focusHelper :: (Bool -> Bool) -- ^ if you want to focus a floating window, 'id'.
+                              -- if you want a non-floating one, 'not'.
+            -> ([Window] -> [Window]) -- ^ if you want the next window, 'id'.
+                                      -- if you want the previous one, 'reverse'.
+            -> X ()
+focusHelper f g = withFocused $ \w -> do
+                 ws <- getWindows
+                 let (before, _:after) = span (/=w) ws
+                 let toFocus = g $ after ++ before
+                 floats <- getFloats
+                 case filter (f . flip elem floats) toFocus of
+                   [] -> return ()
+                   w':_ -> focus w'
+
+
+focusNonFloatUp :: X ()
+focusNonFloatUp = alt2 (G.Modify G.focusUp) $ focusHelper not reverse
+
+focusNonFloatDown :: X ()
+focusNonFloatDown = alt2 (G.Modify G.focusDown) $ focusHelper not id
+
+focusFloatUp :: X ()
+focusFloatUp = focusHelper id reverse
+
+focusFloatDown :: X ()
+focusFloatDown = focusHelper id id
+
+
+-- ** Groups-specific actions
+
+wrap :: G.ModifySpec -> X ()
+wrap = sendMessage . G.Modify
+
+-- | Swap the focused group with the previous one
+swapGroupUp :: X ()
+swapGroupUp = wrap G.swapGroupUp
+
+-- | Swap the focused group with the next one
+swapGroupDown :: X ()
+swapGroupDown = wrap G.swapGroupDown
+
+-- | Swap the focused group with the master group
+swapGroupMaster :: X ()
+swapGroupMaster = wrap G.swapGroupMaster
+
+-- | Move the focus to the previous group
+focusGroupUp :: X ()
+focusGroupUp = wrap G.focusGroupUp
+
+-- | Move the focus to the next group
+focusGroupDown :: X ()
+focusGroupDown = wrap G.focusGroupDown
+
+-- | Move the focus to the master group
+focusGroupMaster :: X ()
+focusGroupMaster = wrap G.focusGroupMaster
+
+-- | Move the focused window to the previous group. The 'Bool' argument
+-- determines what will be done if the focused window is in the very first
+-- group: Wrap back to the end ('True'), or create a new group before
+-- it ('False').
+moveToGroupUp :: Bool -> X ()
+moveToGroupUp b = wrap (G.moveToGroupUp b)
+
+-- | Move the focused window to the next group. The 'Bool' argument
+-- determines what will be done if the focused window is in the very last
+-- group: Wrap back to the beginning ('True'), or create a new group after
+-- it ('False').
+moveToGroupDown :: Bool -> X ()
+moveToGroupDown b = wrap (G.moveToGroupDown b)
+
+-- | Move the focused window to a new group before the current one
+moveToNewGroupUp :: X ()
+moveToNewGroupUp = wrap G.moveToNewGroupUp
+
+-- | Move the focused window to a new group after the current one
+moveToNewGroupDown :: X ()
+moveToNewGroupDown = wrap G.moveToNewGroupDown
+
+-- | Split the focused group in two at the position of the focused
+-- window.
+splitGroup :: X ()
+splitGroup = wrap G.splitGroup

XMonad/Layout/Groups/Wmii.hs

@@ -0,0 +1,133 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Groups.Wmii
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  orphaned
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- A wmii-like layout algorithm.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Groups.Wmii ( -- * Usage
+                                   -- $usage
+
+                                   wmii
+                                 , zoomGroupIn
+                                 , zoomGroupOut
+                                 , zoomGroupReset
+                                 , toggleGroupFull
+                                 , groupToNextLayout
+                                 , groupToFullLayout
+                                 , groupToTabbedLayout
+                                 , groupToVerticalLayout
+
+                                   -- * Useful re-exports
+                                 , shrinkText
+                                 , defaultTheme
+                                 , module XMonad.Layout.Groups.Helpers ) where
+
+import XMonad hiding ((|||))
+
+import qualified XMonad.Layout.Groups as G
+import XMonad.Layout.Groups.Examples
+import XMonad.Layout.Groups.Helpers
+
+import XMonad.Layout.Tabbed
+import XMonad.Layout.Named
+import XMonad.Layout.Renamed
+import XMonad.Layout.LayoutCombinators
+import XMonad.Layout.MessageControl
+import XMonad.Layout.Simplest
+
+
+-- $usage
+-- This module provides a layout inspired by the one used by the wmii
+-- (<http://wmii.suckless.org>) window manager.
+-- Windows are arranged into groups in a horizontal row, and each group can lay out
+-- its windows
+--
+--   * by maximizing the focused one
+--
+--   * by tabbing them (wmii uses a stacked layout, but I'm too lazy to write it)
+--
+--   * by arranging them in a column.
+--
+-- As the groups are arranged in a 'ZoomRow', the relative width of each group can be
+-- increased or decreased at will. Groups can also be set to use the whole screen
+-- whenever they have focus.
+--
+-- You can use the contents of this module by adding
+--
+-- > import XMonad.Layout.Groups.Wmii
+--
+-- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii'
+-- (with a 'Shrinker' and decoration 'Theme' as
+-- parameters) to your layout hook, for example:
+--
+-- > myLayout = wmii shrinkText defaultTheme
+--
+-- To be able to zoom in and out of groups, change their inner layout, etc.,
+-- create key bindings for the relevant actions:
+--
+-- > ((modMask, xK_f), toggleGroupFull)
+--
+-- and so on.
+--
+-- For more information on how to extend your layout hook and key bindings, see
+-- "XMonad.Doc.Extending".
+--
+-- Finally, you will probably want to be able to move focus and windows
+-- between groups in a consistent fashion. For this, you should take a look
+-- at the "XMonad.Layout.Groups.Helpers" module, whose contents are re-exported
+-- by this module.
+
+-- | A layout inspired by wmii
+wmii s t = G.group innerLayout zoomRowG
+    where column = named "Column" $ Tall 0 (3/100) (1/2)
+          tabs = named "Tabs" $ Simplest
+          innerLayout = renamed [CutWordsLeft 3]
+                        $ addTabs s t
+                        $ ignore NextLayout
+                        $ ignore (JumpToLayout "") $ unEscape
+                           $ column ||| tabs ||| Full
+
+-- | Increase the width of the focused group
+zoomGroupIn :: X ()
+zoomGroupIn = zoomColumnIn
+
+-- | Decrease the size of the focused group
+zoomGroupOut :: X ()
+zoomGroupOut = zoomColumnOut
+
+-- | Reset the size of the focused group to the default
+zoomGroupReset :: X ()
+zoomGroupReset = zoomColumnReset
+
+-- | Toggle whether the currently focused group should be maximized
+-- whenever it has focus.
+toggleGroupFull :: X ()
+toggleGroupFull = toggleGroupFull
+
+-- | Rotate the layouts in the focused group.
+groupToNextLayout :: X ()
+groupToNextLayout = sendMessage $ escape NextLayout
+
+-- | Switch the focused group to the \"maximized\" layout.
+groupToFullLayout :: X ()
+groupToFullLayout = sendMessage $ escape $ JumpToLayout "Full"
+
+-- | Switch the focused group to the \"tabbed\" layout.
+groupToTabbedLayout :: X ()
+groupToTabbedLayout = sendMessage $ escape $ JumpToLayout "Tabs"
+
+-- | Switch the focused group to the \"column\" layout.
+groupToVerticalLayout :: X ()
+groupToVerticalLayout = sendMessage $ escape $ JumpToLayout "Column"
+

XMonad/Layout/HintedGrid.hs

@@ -65,7 +65,7 @@ instance LayoutClass Grid Window where
     doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w)
 
 replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)
-replicateS n = runState . replicateM n . State
+replicateS n f = runState . replicateM n $ do (a,s) <- gets f; put s; return a
 
 doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D]
 doColumn width height k adjs =

XMonad/Layout/IM.hs

@@ -25,12 +25,11 @@ module XMonad.Layout.IM (
     -- * TODO
     -- $todo
         Property(..), IM(..), withIM, gridIM,
+        AddRoster,
 ) where
 
 import XMonad
 import qualified XMonad.StackSet as S
-import Data.List
-import XMonad.Layout (splitHorizontallyBy)
 import XMonad.Layout.Grid
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.WindowProperties

XMonad/Layout/ImageButtonDecoration.hs

@@ -0,0 +1,183 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ImageButtonDecoration
+-- Copyright   :  (c) Jan Vornberger 2009
+--                    Alejandro Serrano 2010
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  trupill@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A decoration that includes small image 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.
+--
+-----------------------------------------------------------------------------
+
+-- This module is mostly derived from "XMonad.Layout.DecorationAddons"
+-- and "XMonad.Layout.ButtonDecoration"
+
+module XMonad.Layout.ImageButtonDecoration
+    ( -- * Usage:
+      -- $usage
+      imageButtonDeco
+    , defaultThemeWithImageButtons
+    , imageTitleBarButtonHandler
+    , ImageButtonDecoration
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+import XMonad.Layout.DecorationAddons
+import XMonad.Util.Image
+
+import XMonad.Actions.WindowMenu
+import XMonad.Layout.Minimize
+import XMonad.Layout.Maximize
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.ImageButtonDecoration
+--
+-- Then edit your @layoutHook@ by adding the ImageButtonDecoration to
+-- your layout:
+--
+-- > myL = imageButtonDeco shrinkText defaultThemeWithImageButtons (layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+
+-- The buttons' dimension and placements
+
+buttonSize :: Int
+buttonSize = 10
+
+menuButtonOffset :: Int
+menuButtonOffset = 4
+
+minimizeButtonOffset :: Int
+minimizeButtonOffset = 32
+
+maximizeButtonOffset :: Int
+maximizeButtonOffset = 18
+
+closeButtonOffset :: Int
+closeButtonOffset = 4
+
+
+-- The images in a 0-1 scale to make
+-- it easier to visualize
+
+convertToBool' :: [Int] -> [Bool]
+convertToBool' = map (\x -> x == 1)
+
+convertToBool :: [[Int]] -> [[Bool]]
+convertToBool = map convertToBool'
+
+menuButton' :: [[Int]]
+menuButton' = [[1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1]]
+
+menuButton :: [[Bool]]
+menuButton = convertToBool menuButton'
+
+miniButton' :: [[Int]]
+miniButton' = [[0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [0,0,0,0,0,0,0,0,0,0],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1]]
+
+miniButton :: [[Bool]]
+miniButton = convertToBool miniButton'
+
+maxiButton' :: [[Int]]
+maxiButton' = [[1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,0,0,0,0,0,0,1,1],
+               [1,1,1,1,1,1,1,1,1,1],
+               [1,1,1,1,1,1,1,1,1,1]]
+
+maxiButton :: [[Bool]]
+maxiButton = convertToBool maxiButton'
+
+closeButton' :: [[Int]]
+closeButton' = [[1,1,0,0,0,0,0,0,1,1],
+                [1,1,1,0,0,0,0,1,1,1],
+                [0,1,1,1,0,0,1,1,1,0],
+                [0,0,1,1,1,1,1,1,0,0],
+                [0,0,0,1,1,1,1,0,0,0],
+                [0,0,0,1,1,1,1,0,0,0],
+                [0,0,1,1,1,1,1,1,0,0],
+                [0,1,1,1,0,0,1,1,1,0],
+                [1,1,1,0,0,0,0,1,1,1],
+                [1,1,0,0,0,0,0,0,1,1]]
+
+
+closeButton :: [[Bool]]
+closeButton = convertToBool closeButton'
+
+-- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration.
+-- It will intercept clicks on the buttons of the decoration and invoke the associated action.
+-- To actually see the buttons, you will need to use a theme that includes them.
+-- See 'defaultThemeWithImageButtons' below.
+imageTitleBarButtonHandler :: Window -> Int -> Int -> X Bool
+imageTitleBarButtonHandler mainw distFromLeft distFromRight = do
+    let action = if (fi distFromLeft >= menuButtonOffset &&
+                      fi distFromLeft <= menuButtonOffset + buttonSize)
+                        then focus mainw >> windowMenu >> return True
+                  else if (fi distFromRight >= closeButtonOffset &&
+                           fi distFromRight <= closeButtonOffset + buttonSize)
+                              then focus mainw >> kill >> return True
+                  else if (fi distFromRight >= maximizeButtonOffset &&
+                           fi distFromRight <= maximizeButtonOffset + buttonSize)
+                             then focus mainw >> sendMessage (maximizeRestore mainw) >> return True
+                  else if (fi distFromRight >= minimizeButtonOffset &&
+                           fi distFromRight <= minimizeButtonOffset + buttonSize)
+                             then focus mainw >> minimizeWindow mainw >> return True
+                  else return False
+    action
+
+defaultThemeWithImageButtons :: Theme
+defaultThemeWithImageButtons = defaultTheme {
+                                windowTitleIcons = [ (menuButton, CenterLeft 3),
+                                                     (closeButton, CenterRight 3),
+                                                     (maxiButton, CenterRight 18),
+                                                     (miniButton, CenterRight 33) ]
+                               }
+
+imageButtonDeco :: (Eq a, Shrinker s) => s -> Theme
+                   -> l a -> ModifiedLayout (Decoration ImageButtonDecoration s) l a
+imageButtonDeco s c = decoration s c $ NFD True
+
+data ImageButtonDecoration a = NFD Bool deriving (Show, Read)
+
+instance Eq a => DecorationStyle ImageButtonDecoration a where
+    describeDeco _ = "ImageButtonDeco"
+    decorationCatchClicksHook _ mainw dFL dFR = imageTitleBarButtonHandler mainw dFL dFR
+    decorationAfterDraggingHook _ (mainw, _) decoWin = focus mainw >> handleScreenCrossing mainw decoWin >> return ()