Bump version to 0.8

Since I've been working on a rewrite, it seems only fair that I be forced to
better understand the existing code / issues.

XMonad/Actions/Commands.hs

@@ -41,16 +41,16 @@ import Data.Maybe
 --
 -- Then add a keybinding to the runCommand action:
 --
--- >    , ((modMask x .|. controlMask, xK_y), runCommand commands)
+-- >    , ((modMask x .|. controlMask, xK_y), commands >>= runCommand)
 --
 -- and define the list of commands you want to use:
 --
--- >    commands :: [(String, X ())]
+-- >    commands :: X [(String, X ())]
 -- >    commands = defaultCommands
 --
 -- Whatever key you bound to will now cause a popup menu of internal
--- xmonad commands to appear.  You can change the commands by
--- changing the contents of the list 'commands'.  (If you like it
+-- xmonad commands to appear.  You can change the commands by changing
+-- the contents of the list returned by 'commands'.  (If you like it
 -- enough, you may even want to get rid of many of your other key
 -- bindings!)
 --
@@ -88,8 +88,8 @@ defaultCommands = do
         , ("expand"              , sendMessage Expand                               )
         , ("next-layout"         , sendMessage NextLayout                           )
         , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )
-        , ("restart-wm"          , sr >> restart Nothing True                       )
-        , ("restart-wm-no-resume", sr >> restart Nothing False                      )
+        , ("restart-wm"          , sr >> restart "xmonad" True                       )
+        , ("restart-wm-no-resume", sr >> restart "xmonad" False                      )
         , ("xterm"               , spawn =<< asks (terminal .  config)              )
         , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )
         , ("kill"                , kill                                             )

XMonad/Actions/ConstrainedResize.hs

@@ -16,9 +16,9 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.ConstrainedResize (
-	-- * Usage
-	-- $usage
-	XMonad.Actions.ConstrainedResize.mouseResizeWindow
+        -- * Usage
+        -- $usage
+        XMonad.Actions.ConstrainedResize.mouseResizeWindow
 ) where
 
 import XMonad
@@ -53,5 +53,5 @@ mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
                      y = ey - fromIntegral (wa_y wa)
                      sz = if c then (max x y, max x y) else (x,y)
                  io $ resizeWindow d w `uncurry`
-                    applySizeHints sh sz)
+                    applySizeHintsContents sh sz)
               (float w)

XMonad/Actions/CopyWindow.hs

@@ -1,11 +1,11 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE PatternGuards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.CopyWindow
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  ???
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,12 +17,12 @@
 module XMonad.Actions.CopyWindow (
                                  -- * Usage
                                  -- $usage
-                                 copy, copyWindow, kill1
+                                 copy, copyToAll, copyWindow, killAllOtherCopies, kill1
                                 ) where
 
-import Prelude hiding ( filter )
+import Prelude hiding (filter)
 import qualified Data.List as L
-import XMonad hiding (modify)
+import XMonad hiding (modify, workspaces)
 import XMonad.StackSet
 
 -- $usage
@@ -50,16 +50,31 @@ import XMonad.StackSet
 --
 -- >  , ((modMask x .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
 --
+-- Another possibility which this extension provides is 'making window
+-- always visible' (i.e. always on current workspace), similar to corresponding
+-- metacity functionality. This behaviour is emulated through copying given
+-- window to all the workspaces and then removing it when it's unneeded on
+-- all workspaces any more.
+--
+-- Here is the example of keybindings which provide these actions:
+--
+-- >  , ((modMask x, xK_v )", windows copyToAll) -- @@ Make focused window always visible
+-- >  , ((modMask x .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back
+--
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
 -- | copy. Copy the focussed window to a new workspace.
-copy :: WorkspaceId -> WindowSet -> WindowSet
+copy :: (Eq s, Eq i, Eq a) => i -> StackSet i l a s sd -> StackSet i l a s sd
 copy n s | Just w <- peek s = copyWindow w n s
          | otherwise = s
 
+-- | copyToAll. Copy the focused window to all of workspaces.
+copyToAll :: (Eq s, Eq i, Eq a) => StackSet i l a s sd -> StackSet i l a s sd
+copyToAll s = foldr copy s $ map tag (workspaces s)
+
 -- | copyWindow.  Copy a window to a new workspace
-copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet
+copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> StackSet i l a s sd -> StackSet i l a s sd
 copyWindow w n = copy'
     where copy' s = if n `tagMember` s
                     then view (tag (workspace (current s))) $ insertUp' w $ view n s
@@ -83,3 +98,19 @@ kill1 = do ss <- gets windowset
                                       then windows $ delete'' w
                                       else kill
     where delete'' w = modify Nothing (filter (/= w))
+
+-- | Kill all other copies of focused window (if they're present)
+-- 'All other' means here 'copies, which are not on current workspace'
+--
+-- Consider calling this function after copyToAll
+--
+killAllOtherCopies :: X ()
+killAllOtherCopies = do ss <- gets windowset
+                        whenJust (peek ss) $ \w -> windows $
+                                                   view (tag (workspace (current ss))) .
+                                                   delFromAllButCurrent w
+    where
+      delFromAllButCurrent w ss = foldr ($) ss $
+                                  map (delWinFromWorkspace w . tag) $
+                                  hidden ss ++ map workspace (visible ss)
+      delWinFromWorkspace w wid ss = modify Nothing (filter (/= w)) $ view wid ss

XMonad/Actions/CycleRecentWS.hs

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

XMonad/Actions/CycleSelectedLayouts.hs

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

XMonad/Actions/CycleWS.hs

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

XMonad/Actions/DeManage.hs

@@ -1,10 +1,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DeManage
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --

XMonad/Actions/DynamicWorkspaces.hs

@@ -4,7 +4,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,17 +17,17 @@ module XMonad.Actions.DynamicWorkspaces (
                                          -- * Usage
                                          -- $usage
                                          addWorkspace, removeWorkspace,
+                                         addHiddenWorkspace,
                                          withWorkspace,
                                          selectWorkspace, renameWorkspace,
                                          toNthWorkspace, withNthWorkspace
                                        ) where
 
-import Data.List ( sort )
-
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
 import XMonad.Prompt.Workspace
 import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -63,7 +63,8 @@ mkCompl l s = return $ filter (\x -> take (length s) x == s) l
 
 withWorkspace :: XPConfig -> (String -> X ()) -> X ()
 withWorkspace c job = do ws <- gets (workspaces . windowset)
-                         let ts = sort $ map tag ws
+                         sort <- getSortByIndex
+                         let ts = map tag $ sort ws
                              job' t | t `elem` ts = job t
                                     | otherwise = addHiddenWorkspace t >> job t
                          mkXPrompt (Wor "") c (mkCompl ts) job'
@@ -76,13 +77,15 @@ renameWorkspace conf = workspacePrompt conf $ \w ->
                                        in sets $ removeWorkspace' w s
 
 toNthWorkspace :: (String -> X ()) -> Int -> X ()
-toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
+toNthWorkspace job wnum = do sort <- getSortByIndex
+                             ws <- gets (map tag . sort . workspaces . windowset)
                              case drop wnum ws of
                                (w:_) -> job w
                                [] -> return ()
 
 withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
-withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
+withNthWorkspace job wnum = do sort <- getSortByIndex
+                               ws <- gets (map tag . sort . workspaces . windowset)
                                case drop wnum ws of
                                  (w:_) -> windows $ job w
                                  [] -> return ()
@@ -98,6 +101,8 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
 addWorkspace :: String -> X ()
 addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
 
+
+-- | Add a new hidden workspace with the given name.
 addHiddenWorkspace :: String -> X ()
 addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
                                windows (addHiddenWorkspace' newtag l)

XMonad/Actions/FlexibleManipulate.hs

@@ -17,9 +17,9 @@
 -- Based on the FlexibleResize code by Lukas Mai (mauke).
 
 module XMonad.Actions.FlexibleManipulate (
-	-- * Usage
-	-- $usage
-	mouseWindow, discrete, linear, resize, position
+        -- * Usage
+        -- $usage
+        mouseWindow, discrete, linear, resize, position
 ) where
 
 import XMonad
@@ -92,7 +92,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
             npos = wpos + offset * atl
             nbr = (wpos + wsize) + offset * abr
             ntl = minP (nbr - (32, 32)) npos    --minimum size
-            nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)
+            nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
         moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
         return ())
         (float w)

XMonad/Actions/FlexibleResize.hs

@@ -13,9 +13,9 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Actions.FlexibleResize (
-	-- * Usage
-	-- $usage
-	XMonad.Actions.FlexibleResize.mouseResizeWindow
+        -- * Usage
+        -- $usage
+        XMonad.Actions.FlexibleResize.mouseResizeWindow
 ) where
 
 import XMonad
@@ -53,7 +53,7 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
                  let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y]
                  io $ moveResizeWindow d w (fx px (fromIntegral ex))
                                            (fy py (fromIntegral ey))
-                            `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
+                            `uncurry` applySizeHintsContents sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
               (float w)
     where
     firstHalf :: CInt -> Position -> Bool

XMonad/Actions/FloatKeys.hs

@@ -94,7 +94,7 @@ keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
 keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
 keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
     where
-        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
         nx :: Rational
         nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
         ny :: Rational
@@ -103,7 +103,7 @@ keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (n
 keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
 keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
     where
-        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
         nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
         ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
 

XMonad/Actions/FocusNth.hs

@@ -38,12 +38,13 @@ focusNth :: Int -> X ()
 focusNth = windows . modify' . focusNth'
 
 focusNth' :: Int -> Stack a -> Stack a
-focusNth' n s@(Stack _ ls rs)	| (n < 0) || (n > length(ls) + length(rs)) = s
-				| otherwise = listToStack n (integrate s)
+focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
+                              | otherwise = listToStack n (integrate s)
 
 listToStack :: Int -> [a] -> Stack a
 listToStack n l = Stack t ls rs
-	where	(t:rs)	= drop n l
-		ls	= reverse (take n l)
+ where
+    (t:rs)    = drop n l
+    ls        = reverse (take n l)
 
 

XMonad/Actions/MouseGestures.hs

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

XMonad/Actions/MouseResize.hs

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

XMonad/Actions/NoBorders.hs

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

XMonad/Actions/PerWorkspaceKeys.hs

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

XMonad/Actions/Plane.hs

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

XMonad/Actions/Promote.hs

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

XMonad/Actions/RotSlaves.hs

@@ -12,10 +12,10 @@
 -- place.
 -----------------------------------------------------------------------------
 module XMonad.Actions.RotSlaves (
-	-- $usage
-	rotSlaves', rotSlavesUp, rotSlavesDown,
-	rotAll', rotAllUp, rotAllDown
-	) where
+        -- $usage
+        rotSlaves', rotSlavesUp, rotSlavesDown,
+        rotAll', rotAllUp, rotAllDown
+        ) where
 
 import XMonad.StackSet
 import XMonad

XMonad/Actions/RotView.hs

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

XMonad/Actions/Search.hs

@@ -0,0 +1,247 @@
+{- | Module      :  XMonad.Actions.Search
+   Copyright   :  (C) 2007 Gwern Branwen
+   License     :  None; public domain
+
+   Maintainer  :  <gwern0@gmail.com>
+   Stability   :  unstable
+   Portability :  unportable; depends on XSelection, XPrompt
+
+   A module for easily running Internet searches on web sites through xmonad.
+   Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
+
+   Additional sites welcomed. -}
+module XMonad.Actions.Search (    -- * Usage
+                                  -- $usage
+                               search,
+                               SearchEngine(..),
+                               searchEngine,
+                               promptSearch,
+                               promptSearchBrowser,
+                               selectSearch,
+                               selectSearchBrowser,
+
+                               amazon,
+                               codesearch,
+                               dictionary,
+                               google,
+                               hoogle,
+                               imdb,
+                               maps,
+                               mathworld,
+                               scholar,
+                               thesaurus,
+                               wayback,
+                               wikipedia,
+                               youtube
+
+                                  -- * Use case: searching with a submap
+                                  -- $tip
+
+                          ) where
+
+import Data.Char (chr, ord, isAlpha, isMark, isDigit)
+import Numeric (showIntAtBase)
+import XMonad (X(), MonadIO, liftIO)
+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletion)
+import XMonad.Prompt.Shell (getBrowser)
+import XMonad.Util.Run (safeSpawn)
+import XMonad.Util.XSelection (getSelection)
+
+{- $usage
+
+   This module is intended to allow easy access to databases on the
+   Internet through xmonad's interface. The idea is that one wants to
+   run a search but the query string and the browser to use must come
+   from somewhere. There are two places the query string can come from
+   - the user can type it into a prompt which pops up, or the query
+   could be available already in the X Windows copy\/paste buffer
+   (perhaps you just highlighted the string of interest).
+
+   Thus, there are two main functions: 'promptSearch', and
+   'selectSearch' (implemented using the more primitive 'search'). To
+   each of these is passed an engine function; this is a function that
+   knows how to search a particular site.
+
+   For example, the 'google' function knows how to search Google, and
+   so on. You pass 'promptSearch' and 'selectSearch' the engine you
+   want, the browser you want, and anything special they might need;
+   this whole line is then bound to a key of you choosing in your
+   xmonad.hs. For specific examples, see each function.  This module
+   is easily extended to new sites by using 'searchEngine'.
+
+   The currently available search engines are:
+
+* 'amazon' -- Amazon keyword search.
+
+* 'codesearch' -- Google Labs Code Search search.
+
+* 'dictionary' -- dictionary.reference.com search.
+
+* 'google' -- basic Google search.
+
+* 'hoogle' -- Hoogle, the Haskell libraries search engine.
+
+* 'imdb'   -- the Internet Movie Database.
+
+* 'maps'   -- Google maps.
+
+* 'mathworld' -- Wolfram MathWorld search.
+
+* 'scholar' -- Google scholar academic search.
+
+* 'thesaurus' -- thesaurus.reference.com search.
+
+* 'wayback' -- the Wayback Machine.
+
+* 'wikipedia' -- basic Wikipedia search.
+
+* 'youtube' -- Youtube video search.
+
+Feel free to add more! -}
+
+{- $tip
+
+In combination with "XMonad.Actions.Submap" you can create a powerful
+and easy way to search without adding a whole bunch of bindings.
+
+First import the necessary modules:
+
+> import qualified XMonad.Prompt         as P
+> import qualified XMonad.Actions.Submap as SM
+> import qualified XMonad.Actions.Search as S
+
+Then add the following to your key bindings:
+
+> ...
+> -- Search commands
+> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig)
+> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)
+>
+> ...
+>
+> searchEngineMap method = M.fromList $
+>       [ ((0, xK_g), method S.google)
+>       , ((0, xK_h), method S.hoogle)
+>       , ((0, xK_w), method S.wikipedia)
+>       ]
+
+Make sure to set firefox to open new pages in a new window instead of
+in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages
+should be opened in...@
+
+Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then
+opens a new firefox window that performs the search on Google, Hoogle
+or Wikipedia respectively.
+
+If you select something in whatever application and hit /mod-shift-s/ +
+/g/\//h/\//w/ it will search the selected string with the specified
+engine.
+
+Happy searching! -}
+
+-- | A customized prompt indicating we are searching, and the name of the site.
+data Search = Search Name
+instance XPrompt Search where
+    showXPrompt (Search name)= "Search [" ++ name ++ "]: "
+
+-- | Escape the search string so search engines understand it.
+-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
+-- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.
+escape :: String -> String
+escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
+         where -- Copied from Network.URI.
+           escapeURIString ::
+               (Char -> Bool)      -- a predicate which returns 'False' if should escape
+               -> String           -- the string to process
+               -> String           -- the resulting URI string
+           escapeURIString p s = concatMap (escapeURIChar p) s
+           escapeURIChar :: (Char->Bool) -> Char -> String
+           escapeURIChar p c
+               | p c       = [c]
+               | otherwise = '%' : myShowHex (ord c) ""
+               where
+                 myShowHex :: Int -> ShowS
+                 myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
+                                    []  -> "00"
+                                    [ch] -> ['0',ch]
+                                    cs  -> cs
+                 toChrHex d
+                   | d < 10    = chr (ord '0' + fromIntegral d)
+                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+
+type Browser      = FilePath
+type Query        = String
+type Site         = String
+type Name         = String
+data SearchEngine = SearchEngine Name Site
+
+-- | Given a browser, a search engine, and a search term, perform the
+--   requested search in the browser.
+search :: Browser -> Site -> Query -> X ()
+search browser site query = safeSpawn browser (site ++ (escape query))
+
+{- | Given a base URL, create the 'SearchEngine' that escapes the query and
+   appends it to the base. You can easily define a new engine locally using
+   exported functions without needing to modify "XMonad.Actions.Search":
+
+> myNewEngine = searchEngine "site" "http://site.com/search="
+
+   The important thing is that the site has a interface which accepts the escaped query
+   string as part of the URL. Alas, the exact URL to feed searchEngine varies
+   from site to site, often considerably, so there's no general way to cover this.
+
+   Generally, examining the resultant URL of a search will allow you to reverse-engineer
+   it if you can't find the necessary URL already described in other projects such as Surfraw. -}
+searchEngine :: Name -> Site -> SearchEngine
+searchEngine name site = SearchEngine name site
+
+-- The engines.
+amazon, codesearch, dictionary, google, hoogle, imdb, maps, mathworld,
+  scholar, thesaurus, wayback, wikipedia, youtube :: SearchEngine
+amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
+codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
+dictionary = searchEngine "dictionary" "http://dictionary.reference.com/browse/"
+google     = searchEngine "google"     "http://www.google.com/search?num=100&q="
+hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="
+imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="
+maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
+mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
+scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
+thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
+wikipedia  = searchEngine "wikipedia"  "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
+youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
+{- This doesn't seem to work, but nevertheless, it seems to be the official
+   method at <http://web.archive.org/collections/web/advanced.html> to get the
+   latest backup. -}
+wayback   = searchEngine "wayback" "http://web.archive.org/"
+
+{- | Like 'search', but for use with the output from a Prompt; it grabs the
+   Prompt's result, passes it to a given searchEngine and opens it in a given
+   browser. -}
+promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
+promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config (historyCompletion) $ search browser site
+
+{- | Like 'search', but in this case, the string is not specified but grabbed
+ from the user's response to a prompt. Example:
+
+> , ((modm, xK_g), promptSearch greenXPConfig google)
+
+   This specializes "promptSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+promptSearch :: XPConfig -> SearchEngine -> X ()
+promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine
+
+-- | Like 'search', but for use with the X selection; it grabs the selection,
+--   passes it to a given searchEngine and opens it in a given browser.
+selectSearchBrowser :: Browser -> SearchEngine -> X ()
+selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection
+
+{- | Like 'search', but for use with the X selection; it grabs the selection,
+   passes it to a given searchEngine and opens it in the default browser . Example:
+
+> , ((modm .|. shiftMask, xK_g), selectSearch google)
+
+   This specializes "selectSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+selectSearch :: SearchEngine -> X ()
+selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine

XMonad/Actions/SinkAll.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : Xmonad.Actions.SinkAll
+-- Module       : XMonad.Actions.SinkAll
 -- License      : BSD3-style (see LICENSE)
 -- Stability    : unstable
 -- Portability  : unportable

XMonad/Actions/SwapWorkspaces.hs

@@ -17,10 +17,15 @@ module XMonad.Actions.SwapWorkspaces (
                                      -- * Usage
                                      -- $usage
                                      swapWithCurrent,
-                                     swapWorkspaces
+                                     swapTo,
+                                     swapWorkspaces,
+                                     WSDirection(..)
                                     ) where
 
+import XMonad (windows, X())
 import XMonad.StackSet
+import XMonad.Actions.CycleWS
+import XMonad.Util.WorkspaceCompare
 
 
 -- $usage
@@ -45,6 +50,11 @@ import XMonad.StackSet
 swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
 swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s
 
+-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
+-- This is an @X ()@ so can be hooked up to your keybindings directly.
+swapTo :: WSDirection -> X ()
+swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
+
 -- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
 --   one with the two corresponding workspaces' tags swapped.
 swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd

XMonad/Actions/TagWindows.hs

@@ -193,9 +193,3 @@ tagDelPrompt c = do
 
 tagDelComplList :: X [String]
 tagDelComplList = gets windowset >>= maybe (return []) getTags . peek
-
-
-mkComplFunFromList' :: [String] -> String -> IO [String]
-mkComplFunFromList' l [] = return l
-mkComplFunFromList' l s =
-  return $ filter (\x -> take (length s) x == s) l

XMonad/Actions/UpdatePointer.hs

@@ -0,0 +1,92 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonadContrib.UpdatePointer
+-- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  Robert Marlow <robreim@bobturf.org>
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Causes the pointer to follow whichever window focus changes to. Compliments
+-- the idea of switching focus as the mouse crosses window boundaries to
+-- keep the mouse near the currently focused window
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.UpdatePointer 
+    (
+     -- * Usage
+     -- $usage
+     updatePointer
+     , PointerPosition (..)
+    )
+    where
+
+import XMonad
+import Control.Monad
+import XMonad.StackSet (member)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Actions.UpdatePointer
+--
+-- Enable it by including it in your logHook definition. Eg:
+-- 
+-- > logHook = updatePointer Nearest
+-- 
+-- which will move the pointer to the nearest point of a newly focused window, or
+--
+-- > logHook = updatePointer (Relative 0.5 0.5)
+--
+-- which will move the pointer to the center of a newly focused window.
+--
+-- To use this with an existing logHook, use >> :
+--
+-- > logHook = dynamicLog
+-- >           >> updatePointer (Relative 1 1)
+--
+-- which moves the pointer to the bottom-right corner of the focused window.
+
+data PointerPosition = Nearest | Relative Rational Rational
+
+-- | Update the pointer's location to the currently focused
+-- window unless it's already there, or unless the user was changing
+-- focus with the mouse
+updatePointer :: PointerPosition -> X ()
+updatePointer p = withFocused $ \w -> do
+  ws <- gets windowset
+  dpy <- asks display
+  root <- asks theRoot
+  mouseIsMoving <- asks mouseFocused
+  wa <- io $ getWindowAttributes dpy w
+  (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+  unless (pointWithinRegion rootx rooty (wa_x wa) (wa_y wa) (wa_width wa) (wa_height wa)
+          || mouseIsMoving
+          || not (currentWindow `member` ws)) $
+    case p of
+    Nearest -> do
+      let x = moveWithin rootx (wa_x wa) ((wa_x wa) + (wa_width  wa))
+      let y = moveWithin rooty (wa_y wa) ((wa_y wa) + (wa_height wa))
+      io $ warpPointer dpy none root 0 0 0 0 (fromIntegral x) (fromIntegral y)
+    Relative h v ->
+      io $ warpPointer dpy none w 0 0 0 0
+           (fraction h (wa_width wa)) (fraction v (wa_height wa))
+        where fraction x y = floor (x * fromIntegral y)
+
+moveWithin :: Integral a => a -> a -> a -> a
+moveWithin current lower upper =
+    if current < lower
+    then lower
+    else if current > upper
+         then upper
+         else current
+
+-- Test that a point resides within a region. 
+-- This belongs somewhere more generally accessible than this module.
+pointWithinRegion :: Integral a => a -> a -> a -> a -> a -> a -> Bool
+pointWithinRegion px py rx ry rw rh =
+    within px rx (rx + rw) && within py ry (ry + rh)
+    where within x left right = x >= left && x <= right

XMonad/Actions/Warp.hs

@@ -15,6 +15,8 @@
 module XMonad.Actions.Warp (
                            -- * Usage
                            -- $usage
+                           banish,
+                           Corner(..),
                            warpToScreen,
                            warpToWindow
                           ) where
@@ -44,6 +46,26 @@ Note that warping to a particular screen may change the focus.
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+
+data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight
+
+{- | Move the mouse cursor to a corner of the screen. Useful for
+   uncluttering things.
+
+   Internally, this uses numerical parameters. We parametrize on the 'Corner'
+   type so the user need not see the violence inherent in
+   the system.
+
+   'warpToScreen' and 'warpToWindow' can be used in a variety of
+   ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
+   which moves the mouse pointer to a corner? warpToWindow can do that! -}
+banish :: Corner -> X ()
+banish direction = case direction of
+                     LowerRight -> warpToWindow 1 1
+                     LowerLeft  -> warpToWindow 0 1
+                     UpperLeft  -> warpToWindow 0 0
+                     UpperRight  -> warpToWindow 1 0
+
 fraction :: (Integral a, Integral b) => Rational -> a -> b
 fraction f x = floor (f * fromIntegral x)
 

XMonad/Actions/WindowBringer.hs

@@ -17,7 +17,8 @@
 module XMonad.Actions.WindowBringer (
                                     -- * Usage
                                     -- $usage
-                                    gotoMenu, bringMenu, windowMapWith
+                                    gotoMenu, bringMenu, windowMap,
+                                    bringWindow
                                    ) where
 
 import Data.Char (toLower)
@@ -47,29 +48,29 @@ import XMonad.Util.NamedWindows (getName)
 -- | Pops open a dmenu with window titles. Choose one, and you will be
 --   taken to the corresponding workspace.
 gotoMenu :: X ()
-gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView)
- where workspaceMap = windowMapWith (W.tag . fst)
+gotoMenu = actionMenu W.focusWindow
 
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
-bringMenu = windowMap >>= actionMenu (windows . bringWindow)
- where windowMap = windowMapWith snd
-       bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
+bringMenu = actionMenu bringWindow
 
--- | Calls dmenuMap to grab the appropriate element from the Map, and hands it
---   off to action if found.
-actionMenu :: (a -> X ()) -> M.Map String a -> X ()
-actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action
+-- | Brings the specified window into the current workspace.
+bringWindow :: Window -> X.WindowSet -> X.WindowSet
+bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
 
--- | Generates a Map from window name to \<whatever you specify\>. For
---   use with dmenuMap.
-windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a)
-windowMapWith value = do -- TODO: extract the pure, creamy center.
+-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
+--   if found.
+actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()
+actionMenu action = windowMap >>= dmenuMap >>= flip X.whenJust (windows . action)
+
+-- | A map from window names to Windows.
+windowMap :: X (M.Map String Window)
+windowMap = do
   ws <- gets X.windowset
   M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
  where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
-       keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w
+       keyValuePair ws w = flip (,) w `fmap` decorateName ws w
 
 -- | Returns the window name as will be listed in dmenu.
 --   Lowercased, for your convenience (since dmenu is case-sensitive).

XMonad/Actions/WindowGo.hs

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

XMonad/Actions/WindowNavigation.hs

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

XMonad/Actions/WmiiActions.hs

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

XMonad/Config/Arossato.hs

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

XMonad/Config/Desktop.hs

@@ -0,0 +1,37 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Desktop
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+--
+-- This module provides a config suitable for use with a desktop
+-- environment such as KDE or GNOME.
+
+module XMonad.Config.Desktop (
+    -- * Usage
+    -- -- $usage
+    desktopConfig,
+    desktopLayoutModifiers
+    ) where
+
+import XMonad
+import XMonad.Config (defaultConfig)
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.EwmhDesktops
+
+import qualified Data.Map as M
+
+desktopConfig = defaultConfig
+    { logHook    = ewmhDesktopsLogHook
+    , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
+    , manageHook = manageHook defaultConfig <+> manageDocks
+    , keys       = \c -> desktopKeys c `M.union` keys defaultConfig c }
+
+desktopKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_b), sendMessage ToggleStruts) ]
+
+desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout

XMonad/Config/Dons.hs

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

XMonad/Config/Droundy.hs

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

XMonad/Config/Gnome.hs

@@ -0,0 +1,55 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Gnome
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+--
+-- This module provides a config suitable for use with the GNOME desktop
+-- environment.
+
+module XMonad.Config.Gnome (
+    -- * Usage
+    -- -- $usage
+    gnomeConfig,
+    gnomeRun
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Gnome
+-- >
+-- > main = xmonad gnomeConfig
+-- 
+
+gnomeConfig = desktopConfig
+    { terminal = "gnome-terminal"
+    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c }
+
+gnomeKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_p), gnomeRun)
+    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
+
+-- | Launch the "Run Application" dialog.  gnome-panel must be running for this
+-- to work.
+gnomeRun :: X ()
+gnomeRun = withDisplay $ \dpy -> do
+    rw <- asks theRoot
+    gnome_panel <- getAtom "_GNOME_PANEL_ACTION"
+    panel_run   <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG"
+
+    io $ allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw gnome_panel 32 panel_run 0
+        sendEvent dpy rw False structureNotifyMask e
+        sync dpy False

XMonad/Config/Kde.hs

@@ -0,0 +1,41 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Kde
+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+--
+-- This module provides a config suitable for use with the KDE desktop
+-- environment.
+
+module XMonad.Config.Kde (
+    -- * Usage
+    -- -- $usage
+    kdeConfig
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Kde
+-- >
+-- > main = xmonad kdeConfig
+-- 
+
+kdeConfig = desktopConfig
+    { terminal = "konsole"
+    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }
+
+kdeKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")
+    , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
+    ]

XMonad/Config/PlainConfig.hs

@@ -0,0 +1,528 @@
+{-# LANGUAGE 
+  FlexibleInstances, 
+  FlexibleContexts, 
+  MultiParamTypeClasses, 
+  ExistentialQuantification 
+  #-}
+
+-------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.PlainConfig
+-- Copyright   :  Braden Shepherdson <Braden.Shepherdson@gmail.com>
+-- License     :  BSD3
+-- 
+-- Maintainer  :  Braden Shepherdson <Braden.Shepherdson@gmail.com>
+--
+-- Proof-of-concept (but usable) plain-text configuration file
+-- parser, for use instead of xmonad.hs. Does not require recompilation,
+-- allowing xmonad to be free of the GHC dependency.
+--
+-------------------------------------------------------------------------
+
+
+module XMonad.Config.PlainConfig
+    (
+     -- * Introduction
+     -- $usage
+
+     -- * Supported Layouts
+     -- $layouts
+
+     -- * Support Key Bindings
+     -- $keys
+
+     -- * Other Notes
+     -- $notes
+
+     -- * Example Config File
+     -- $example
+
+     plainConfig ,readConfig, checkConfig
+    )
+where
+
+
+import XMonad
+import System.Exit
+
+import qualified XMonad.StackSet as W
+import qualified Data.Map        as M
+import Data.List
+import Data.Maybe (isJust,fromJust)
+import Data.Char (isSpace)
+
+
+--import Control.Monad
+import Control.Monad.Error
+import Control.Monad.Identity
+
+import Control.Arrow ((&&&))
+
+import Text.ParserCombinators.ReadP
+
+import System.IO
+import Control.Exception (bracket)
+
+import XMonad.Util.EZConfig (mkKeymap)
+
+
+
+-- $usage
+-- The @xmonad.hs@ file is very minimal when used with PlainConfig.
+-- It typically contains only the following:
+--
+-- > module Main where
+-- > import XMonad
+-- > import XMonad.Config.PlainConfig (plainConfig)
+-- > main = plainConfig
+--
+-- The 'plainConfig' function parses @~\/.xmonad\/xmonad.conf@, 
+-- the format of which is described below.
+
+
+-- $layouts
+-- Only 'Tall', 'Wide' and 'Full' are supported at present.
+
+
+
+-- $keys
+-- 
+-- Key bindings are specified as a pair of an arbitrary EZConfig and 
+-- one of the following:
+--
+-- @   Name                     Haskell equivalent                                          Default binding(s)@
+-- 
+-- * @spawn \<cmd\>           spawn \"\<cmd\>\"                                               none@
+-- 
+-- * @kill                  kill                                                        M-S-c@
+-- 
+-- * @nextLayout            sendMessage NextLayout                                      M-\<Space\>@
+-- 
+-- * @refresh               refresh                                                     M-S-\<Space\>@
+-- 
+-- * @focusDown             windows W.focusDown                                         M-\<Tab\>, M-j@
+-- 
+-- * @focusUp               windows W.focusUp                                           M-k@
+-- 
+-- * @focusMaster           windows W.focusMaster                                       M-m@
+-- 
+-- * @swapDown              windows W.swapDown                                          M-S-j@
+-- 
+-- * @swapUp                windows W.swapUp                                            M-S-k@
+-- 
+-- * @swapMaster            windows W.swapMaster                                        M-\<Return\>@
+-- 
+-- * @shrink                sendMessage Shrink                                          M-h@
+-- 
+-- * @expand                sendMessage Expand                                          M-l@
+-- 
+-- * @sink                  withFocused $ windows . W.sink                              M-t@
+-- 
+-- * @incMaster             sendMessage (IncMasterN 1)                                  M-,@
+-- 
+-- * @decMaster             sendMessage (IncMasterN (-1))                               M-.@
+-- 
+-- * @quit                  io $ exitWith ExitSuccess                                   M-S-q@
+-- 
+-- * @restart               broadcastMessageReleaseResources >> restart \"xmonad\" True   M-q@
+-- 
+
+
+-- $notes
+-- Submaps are allowed.
+-- These settings override the defaults. Changes made here will be used over
+-- the default bindings for those keys.
+
+
+-- $example
+-- An example @~\/.xmonad\/xmonad.conf@ file follows:
+--
+-- @modMask       = 3@
+--
+-- @numlockMask   = 2@
+--
+-- @borderWidth   = 1@
+--
+-- @normalBorderColor    	=   #dddddd@
+--
+-- @focusedBorderColor      =   #00ff00@
+--
+-- @terminal=urxvt@
+--
+-- @workspaces=[\"1: IRC\",\"2: Web\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\"]@
+--
+-- @focusFollowsMouse=True@
+--
+-- @layouts=[\"Tall\",\"Full\",\"Wide\"]@
+--
+-- @key=(\"M-x t\", \"spawn xmessage Test\")@
+--
+-- @manageHook=(ClassName \"MPlayer\"       , \"float\"  )@
+--
+-- @manageHook=(ClassName \"Gimp\"          , \"float\"  )@
+--
+-- @manageHook=(Resource  \"desktop_window\", \"ignore\" )@
+--
+-- @manageHook=(Resource  \"kdesktop\"      , \"ignore\" )@
+--
+-- @manageHook=(Resource  \"gnome-panel\"   , \"ignore\" )@
+--
+
+
+
+
+
+
+----------------------------------------------------------------
+------ Several functions for parsing the key-value file. -------
+----------------------------------------------------------------
+
+parseKVBy :: Char -> ReadP (String,String)
+parseKVBy sep = do
+  skipSpaces 
+  k <- munch1 (\x -> x /= ' ' && x /= sep) 
+  skipSpaces
+  char kvSep
+  skipSpaces
+  v <- munch1 (\x -> x /= ' ') --or EOS 
+  return (k,v)
+
+parseKVVBy :: Char -> ReadP (String,String)
+parseKVVBy sep = do
+  skipSpaces 
+  k <- munch1 (\x -> x /= ' ' && x /= sep) 
+  skipSpaces
+  char kvSep
+  skipSpaces
+  v <- munch1 (const True) -- until EOS
+  return (k,v)
+
+
+kvSep :: Char
+kvSep = '='
+
+parseKV, parseKVV :: ReadP (String,String)
+parseKV  = parseKVBy  kvSep
+parseKVV = parseKVVBy kvSep
+
+
+
+readKV :: String -> Integer -> RC (String,String)
+readKV s ln = case readP_to_S parseKV s of
+                [((k,v),"")] -> return (k,v) --single, correct parse
+                []           -> throwError [(ln,"No parse")]
+                _           -> do
+                  case readP_to_S parseKVV s of
+                    [((k,v),"")] -> return (k,v) --single, correct parse
+                    []           -> throwError [(ln,"No parse")]
+                    xs           -> throwError [(ln,"Ambiguous parse: "
+                                                 ++ show xs)]
+
+
+
+isComment :: String -> Bool
+isComment = not . null . readP_to_S parseComment 
+  where parseComment = skipSpaces >> char '#' >> return ()
+    -- null means failed parse, so _not_ a comment.
+
+
+isBlank :: String -> Bool
+isBlank = null . filter (not . isSpace)
+
+
+type RC = ErrorT [(Integer,String)] Identity
+
+instance Error [(Integer,String)] where
+    noMsg  = [(-1, "Unknown error.")]
+    strMsg s = [(-1, s)]
+
+
+parseFile :: [String] -> RC (XConfig Layout)
+parseFile ss = parseLines baseConfig theLines
+  where theLines = filter (not . liftM2 (||) isComment isBlank . snd) 
+                   $ zip [1..] ss
+        
+
+
+parseLines :: XConfig Layout -> [(Integer,String)] -> RC (XConfig Layout)
+parseLines = foldM parse
+
+
+parse :: XConfig Layout -> (Integer, String) -> RC (XConfig Layout)
+parse xc (ln,s) = do
+  (k,v) <- readKV s ln
+  case M.lookup k commands of
+    Nothing -> throwError [(ln,"Unknown command: "++k)]
+    Just f  -> f v ln xc
+
+
+
+
+----------------------------------------------------------------
+-- Now the semantic parts, that convert from the relevant     --
+-- key-value entries to values in an XConfig                  --
+----------------------------------------------------------------
+
+
+
+type Command = String -> Integer -> XConfig Layout -> RC (XConfig Layout)
+
+commands :: M.Map String Command
+commands = M.fromList $ 
+           [("modMask"             , cmd_modMask           )
+           ,("numlockMask"         , cmd_numlockMask       )
+           ,("normalBorderColor"   , cmd_normalBorderColor )
+           ,("focusedBorderColor"  , cmd_focusedBorderColor)
+           ,("terminal"            , cmd_terminal          )
+           ,("workspaces"          , cmd_workspaces        )
+           ,("focusFollowsMouse"   , cmd_focusFollowsMouse )
+           ,("layouts"             , cmd_layouts           )
+           ,("key"                 , cmd_key               )
+           ,("manageHook"          , cmd_manageHook        )
+           ,("borderWidth"         , cmd_borderWidth       )
+           ]
+
+
+-- | Behind-the-scenes helper for both 'cmd_modMask' and 'cmd_numlockMask'.
+genericModKey :: (KeyMask -> XConfig Layout) -> Command
+genericModKey f s ln _ = do
+  x <- rcRead s ln :: RC Integer
+  case lookup x (zip [1..] [mod1Mask,mod2Mask,mod3Mask,mod4Mask,mod5Mask]) of
+    Just y  -> return $ f y
+    Nothing -> throwError [(ln,"Invalid mod key number: "++ show x)]
+  
+
+-- | Reads the mod key modifier number.
+cmd_modMask :: Command
+cmd_modMask s ln xc = genericModKey (\k -> xc{modMask = k}) s ln xc
+
+-- | Reads the numlock key modifier number.
+cmd_numlockMask :: Command
+cmd_numlockMask s ln xc = genericModKey (\k -> xc{numlockMask = k}) s ln xc
+
+
+-- | Reads the border width.
+cmd_borderWidth :: Command
+cmd_borderWidth s ln xc = do
+  w <- rcRead s ln
+  return $ xc { borderWidth = w }
+
+
+-- | Reads the colors but just keeps them as RRGGBB Strings.
+cmd_normalBorderColor, cmd_focusedBorderColor :: Command
+cmd_normalBorderColor  s _ xc = return $ xc{ normalBorderColor  = s } 
+cmd_focusedBorderColor s _ xc = return $ xc{ focusedBorderColor = s }
+
+
+-- | Reads the terminal. It is just a String, no parsing.
+cmd_terminal :: Command
+cmd_terminal s _ xc = return $ xc{ terminal = s }
+
+
+-- | Reads the workspace tag list. This is given as a Haskell [String].
+cmd_workspaces :: Command
+cmd_workspaces s ln xc = rcRead s ln >>= \x -> return xc{ workspaces = x }
+
+
+-- | Reads the focusFollowsMouse, as a Haskell Bool.
+cmd_focusFollowsMouse :: Command
+cmd_focusFollowsMouse s ln xc = rcRead s ln >>= 
+                                \x -> return xc{focusFollowsMouse = x}
+
+
+-- | The list known layouts, mapped by name.
+--   An easy location for improvement is to add more contrib layouts here.
+layouts :: M.Map String (Layout Window)
+layouts = M.fromList
+          [("Tall", Layout (Tall 1 (3/100) (1/2)))
+          ,("Wide", Layout (Mirror (Tall 1 (3/100) (1/2))))
+          ,("Full", Layout Full)
+          ]
+
+
+-- | Expects a [String], the strings being layout names. Quotes required.
+--   Draws from the `layouts' list above.
+cmd_layouts :: Command
+cmd_layouts s ln xc = do
+  xs <- rcRead s ln -- read the list of strings
+  let ls = map (id &&& (flip M.lookup) layouts) xs
+  when (null ls) $ throwError [(ln,"Empty layout list")]
+  case filter (not . isJust . snd) ls of
+    [] -> return $ xc{ layoutHook = foldr1 
+                       (\(Layout l) (Layout r) -> 
+                            Layout (l ||| r)) (map (fromJust . snd) ls) 
+                     }
+    ys -> throwError $ map (\(x,_) -> (ln, "Unknown layout: "++ x)) ys
+
+
+
+-- | A Map from names to key binding actions.
+key_actions :: M.Map String (X ())
+key_actions = M.fromList
+              [("kill"            , kill                   )
+              ,("nextLayout"      , sendMessage NextLayout )
+              --,("prevLayout"      , sendMessage PrevLayout )
+              --,("resetLayout"     , setLayout $ XMonad.layoutHook conf)
+              ,("refresh"         , refresh                )
+              ,("focusDown"       , windows W.focusDown    )
+              ,("focusUp"         , windows W.focusUp      )
+              ,("focusMaster"     , windows W.focusMaster  )
+              ,("swapMaster"      , windows W.swapMaster   )
+              ,("swapDown"        , windows W.swapDown     )
+              ,("swapUp"          , windows W.swapUp       )
+              ,("shrink"          , sendMessage Shrink     )
+              ,("expand"          , sendMessage Expand     )
+              ,("sink"            , withFocused $ windows . W.sink)
+              ,("incMaster"       , sendMessage (IncMasterN   1))
+              ,("decMaster"       , sendMessage (IncMasterN (-1)))
+              ,("quit"            , io $ exitWith ExitSuccess)
+              ,("restart"         , broadcastMessage ReleaseResources 
+                                      >> restart "xmonad" True)
+              ]
+
+
+-- | Expects keys as described in the preamble, as 
+--   (\"EZConfig key name\", \"action name\"), 
+--   eg. (\"M-S-t\", \"spawn thunderbird\")
+--   One key per "key=" line.
+cmd_key :: Command
+cmd_key s ln xc = do
+  (k,v) <- rcRead s ln
+  if "spawn " `isPrefixOf` v
+    then return $ xc { 
+                      keys = \c -> M.union (mkKeymap c 
+                                            [(k, spawn (drop 6 v))]
+                                           ) ((keys xc) c) 
+                     }
+    else do
+          case M.lookup v key_actions of
+            Nothing -> throwError [(ln, "Unknown key action \"" ++ v ++ "\"")]
+            Just ac -> return $ 
+                       xc { keys = \c -> M.union (mkKeymap c [(k, ac)])
+                                   ((keys xc) c) 
+                          }
+
+
+
+-- | Map of names to actions for 'ManageHook's.
+manageHook_actions :: M.Map String ManageHook
+manageHook_actions = M.fromList 
+                     [("float"  , doFloat  )
+                     ,("ignore" , doIgnore )
+                     ]
+
+
+-- | Parses 'ManageHook's in the form given in the preamble.
+--   eg. (ClassName \"MPlayer\", \"float\")
+cmd_manageHook :: Command
+cmd_manageHook s ln xc = do
+  (k,v) <- rcRead s ln
+  let q = parseQuery k
+  if "toWorkspace " `isPrefixOf` v
+    then return $ xc { manageHook = manageHook xc <+> 
+                       (q --> doShift (drop 12 v))
+                     }
+    else case M.lookup v manageHook_actions of
+           Nothing -> throwError [(ln, "Unknown ManageHook action \"" 
+                                   ++ v ++ "\"")]
+           Just ac -> return $ xc { manageHook = manageHook xc <+> (q --> ac) }
+
+
+
+-- | Core of the ManageHook expression parser.
+--   Taken from Roman Cheplyaka's WindowProperties
+parseQuery :: Property -> Query Bool
+parseQuery (Title s)       = title =? s
+parseQuery (ClassName s)   = className =? s
+parseQuery (Resource s)    = resource =? s
+parseQuery (And p q)       = parseQuery p <&&> parseQuery q
+parseQuery (Or  p q)       = parseQuery p <&&> parseQuery q
+parseQuery (Not p)         = not `fmap` parseQuery p
+parseQuery (Const b)       = return b
+
+
+-- | Property constructors are quite self-explaining.
+--   Taken from Roman Cheplyaka's WindowProperties
+data Property = Title String
+              | ClassName String
+              | Resource String
+              | And Property Property  
+              | Or  Property Property
+              | Not Property
+              | Const Bool
+              deriving (Read, Show)
+
+
+
+-- | A wrapping of the read function into the RC monad.
+rcRead :: (Read a) => String -> Integer -> RC a
+rcRead s ln = case reads s of 
+                [(x,"")] -> return x
+                _        -> throwError [(ln, "Failed to parse value")]
+
+
+
+-- | The standard Config.hs 'defaultConfig', with the layout wrapped.
+baseConfig :: XConfig Layout
+baseConfig = defaultConfig{ layoutHook = Layout (layoutHook defaultConfig) }
+
+
+
+-- | Core function that attempts to parse @~\/.xmonad\/xmonad.conf@
+readConfig :: IO (Maybe (XConfig Layout))
+readConfig = do
+  dir <- getXMonadDir
+  cs <- bracket (openFile (dir++"/xmonad.conf") ReadMode)
+             (\h -> hClose h) -- vv force the lazy IO
+             (\h -> (lines `fmap` hGetContents h) >>= \ss -> 
+                    length ss `seq` return ss)
+  let xce = runIdentity $ runErrorT $ parseFile cs
+  case xce of
+    Left es  -> mapM_ (\(ln,e) -> 
+                           putStrLn $ "readConfig error: line "++show ln++
+                                        ": "++ e) es 
+                >> return Nothing
+    Right xc -> return $ Just xc
+
+
+-- | Attempts to run readConfig, and checks if it failed.
+checkConfig :: IO Bool
+checkConfig = isJust `fmap` readConfig
+
+
+
+{-  REMOVED: It was for debugging, and causes an 'orphaned instances'
+             warning to boot.
+
+
+
+-- | Reads in the config, and then prints the resulting XConfig
+dumpConfig :: IO ()
+dumpConfig = readConfig >>= print
+
+
+instance Show (XConfig Layout) where
+    show x = "XConfig { "
+             ++ "normalBorderColor = "++ normalBorderColor x ++", "
+             ++ "focusedBorderColor = "++ focusedBorderColor x++", "
+             ++ "terminal = "++ terminal x ++", "
+             ++ "workspaces = "++ show (workspaces x) ++", "
+             ++ "numlockMask = "++ show (numlockMask x) ++", "
+             ++ "modMask = "++ show (modMask x) ++", "
+             ++ "borderWidth = "++ show (borderWidth x) ++", "
+             ++ "focusFollowsMouse = "++ show (focusFollowsMouse x) ++", "
+             ++ "layouts = "++ show (layoutHook x) ++" }"
+
+-}
+
+-- | Handles the unwrapping of the Layout. Intended for use as
+--   @main = plainConfig@
+plainConfig :: IO ()
+plainConfig = do
+  conf <- readConfig
+  case conf of
+    (Just xc@XConfig{layoutHook= (Layout l)}) -> 
+        xmonad (xc{ layoutHook = l })
+    Nothing                                   -> 
+        spawn $ "xmessage Failed to read xmonad.conf. See xmonad.errors."
+

XMonad/Config/Sjanssen.hs

@@ -8,7 +8,7 @@ import XMonad.Layout.Tabbed
 import XMonad.Layout.HintedTile
 import XMonad.Config (defaultConfig)
 import XMonad.Layout.NoBorders
-import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.DynamicLog hiding (xmobar)
 import XMonad.Hooks.ManageDocks
 import XMonad.Prompt
 import XMonad.Prompt.Shell
@@ -20,20 +20,24 @@ import System.IO (hPutStrLn)
 sjanssenConfig = do
     xmobar <- spawnPipe "xmobar"
     return $ defaultConfig
-        { terminal = "urxvt"
-        , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]
+        { terminal = "urxvtc"
+        , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
         , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }
-        , modMask = mod4Mask
         , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
                 [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
                 , ((modm, button2), (\w -> focus w >> windows W.swapMaster))
                 , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
         , keys = \c -> mykeys c `M.union` keys defaultConfig c
-        , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf)
-        , manageHook = manageHook defaultConfig <+> manageDocks
+        , layoutHook = modifiers layouts
+        , manageHook = composeAll [className =? x --> doF (W.shift w)
+                                    | (x, w) <- [ ("Firefox", "web")
+                                                , ("Ktorrent", "7")]]
+                       <+> manageHook defaultConfig <+> manageDocks
         }
  where
-    tiled   = HintedTile 1 0.03 0.5
+    tiled     = HintedTile 1 0.03 0.5 TopLeft
+    layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme
+    modifiers = avoidStruts . smartBorders
 
     mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
         [((modm,               xK_p     ), shellPrompt myPromptConfig)
@@ -44,7 +48,7 @@ sjanssenConfig = do
         ]
 
     myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
-    myTConf = defaultTConf { fontName = myFont }
+    myTheme = defaultTheme { fontName = myFont }
     myPromptConfig = defaultXPConfig
                         { position = Top
                         , font = myFont

XMonad/Config/Xfce.hs

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

XMonad/Doc.hs

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

XMonad/Doc/Configuring.hs

@@ -53,11 +53,11 @@ NOTE for users of previous versions (< 0.5) of xmonad: this is a major
 change in the way xmonad is configured.  Prior to version 0.5,
 configuring xmonad required editing an xmonad source file called
 Config.hs, recompiling xmonad, and then restarting.  From version 0.5
-onwards, however, all you have to do is edit xmonad.hs and restart
-with @mod-q@; xmonad does the recompiling itself.  The format of the
-configuration file has also changed; it is now simpler and much
-shorter, only requiring you to list those settings which are different
-from the defaults.
+onwards, however, you should NOT edit this file.  All you have to do
+is edit xmonad.hs and restart with @mod-q@; xmonad does the
+recompiling itself.  The format of the configuration file has also
+changed; it is now simpler and much shorter, only requiring you to
+list those settings which are different from the defaults.
 
 -}
 
@@ -88,13 +88,13 @@ Overriding default settings like this (using \"record update
 syntax\"), will yield the shortest config file, as you only have to
 describe values that differ from the defaults.
 
-An alternative is to inline the entire default config file from
-xmonad, and edit values you wish to change. This is requires more
-work, but some users may find this easier. You can find the defaults
-in the "XMonad.Config" module of the core xmonad library.
-
-However, note that (unlike previous versions of xmonad) you should not
-edit Config.hs itself.
+As an alternative, you can copy the template @xmonad.hs@ file (found
+either in the @man@ directory, if you have the xmonad source, or on
+the xmonad wiki at
+@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_xmonad.hs@)
+into your @~\/.xmonad\/@ directory.  This template file contains all
+the default settings spelled out, and you should be able to simply
+change the ones you would like to change.
 
 To see what fields can be customized beyond the ones in the example
 above, the definition of the 'XMonad.Core.XConfig' data structure can
@@ -110,7 +110,7 @@ is syntactically and type correct.  You can do this easily by loading
 your configuration file in the Haskell interpreter:
 
 >    $ ghci ~/.xmonad/xmonad.hs
->    GHCi, version 6.8.1: http://www.haskell.org/ghc/  :? for help
+>    GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
 >    Loading package base ... linking ... done.
 >    Ok, modules loaded: Main.
 >
@@ -122,14 +122,17 @@ Ok, looks good.
 Note, however, that if you skip this step and try restarting xmonad
 with errors in your xmonad.hs, it's not the end of the world; xmonad
 will simply display a window showing the errors and continue with the
-previous configuration settings.
+previous configuration settings. (This assumes that you have the
+\'xmessage\' utility installed; you probably do.)
 
 -}
 
 {- $load
 #Loading_your_configuration#
 
-To get xmonad to use your new settings, type @mod-q@. xmonad will
+To get xmonad to use your new settings, type @mod-q@. (Remember, the
+mod key is \'alt\' by default, but you can configure it to be
+something else, such as your Windows key if you have one.) xmonad will
 attempt to compile this file, and run it.  If everything goes well,
 xmonad will seamlessly restart itself with the new settings, keeping
 all your windows, layouts, etc. intact.  (If you change anything

XMonad/Doc/Developing.hs

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

XMonad/Doc/Extending.hs

@@ -125,14 +125,17 @@ edit your key bindings.
 * "XMonad.Actions.CopyWindow": duplicating windows on multiple
   workspaces.
 
-* "XMonad.Actions.CycleWS": move between workspaces.
+* "XMonad.Actions.CycleSelectedLayouts": bind a key to cycle through a
+  particular subset of your layouts.
+
+* "XMonad.Actions.CycleWS": move between workspaces in various ways.
 
 * "XMonad.Actions.DeManage": cease management of a window without
   unmapping it.
 
 * "XMonad.Actions.DwmPromote": dwm-like master window swapping.
 
-* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces.
+* "XMonad.Actions.DynamicWorkspaces": add, delete, and rename workspaces.
 
 * "XMonad.Actions.FindEmptyWorkspace": find an empty workspace.
 
@@ -148,9 +151,23 @@ edit your key bindings.
 
 * "XMonad.Actions.MouseGestures": bind mouse gestures to actions.
 
+* "XMonad.Actions.MouseResize": use with
+  "XMonad.Layout.WindowArranger" to resize windows with the mouse when
+  using a floating layout.
+
+* "XMonad.Actions.NoBorders": forcibly remove borders from a window.
+  Not to be confused with "XMonad.Layout.NoBorders".
+
+* "XMonad.Actions.PerWorkspaceKeys": configure keybindings
+  per-workspace.
+
+* "XMonad.Actions.Promote": An action to move the focused window to
+  the master pane, or swap the master with the next window.
+
 * "XMonad.Actions.RotSlaves": rotate non-master windows.
 
-* "XMonad.Actions.RotView": cycle through non-empty workspaces.
+* "XMonad.Actions.Search": provide helpful functions for easily
+  running web searchs.
 
 * "XMonad.Actions.SimpleDate": display the date in a popup menu.
 
@@ -164,12 +181,16 @@ edit your key bindings.
 
 * "XMonad.Actions.TagWindows": tag windows and select by tag.
 
+* "XMonad.Actions.UpdatePointer": mouse-follows-focus.
+
 * "XMonad.Actions.Warp": warp the pointer.
 
 * "XMonad.Actions.WindowBringer": bring windows to you, and you to
   windows.
 
-* "XMonad.Actions.WmiiActions": wmii-style actions.
+* "XMonad.Actions.WindowGo": travel to windows based on various
+  criteria; conditionally start a program if a window does not exist,
+  or travel to that window if it does.
 
 -}
 
@@ -222,9 +243,18 @@ Here is a list of the modules found in @XMonad.Hooks@:
   putting in a status bar of some sort. See
   "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".
 
+* "XMonad.Hooks.EventHook": a hook to handle X events at the layout level.
+
 * "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications.
 
-* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately.
+* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows (such as
+  status bars) appropriately, by de-managing them and creating
+  appropriate gaps so as not to place other windows covering them.
+
+* "XMonad.Hooks.ManageHelpers": provide helper functions to be used
+  in @manageHook@.
+
+* "XMonad.Hooks.ServerMode": example use of "XMonad.Hooks.EventHook".
 
 * "XMonad.Hooks.SetWMName": set the WM name.  Useful when e.g. running
   Java GUI programs.
@@ -261,13 +291,24 @@ For more information on using those modules for customizing your
 
 * "XMonad.Layout.Combo": combine multiple layouts into one.
 
+* "XMonad.Layout.Decoration": decorated layouts.
+
+* "XMonad.Layout.DecorationMadness": some examples of decorated layouts.
+
 * "XMonad.Layout.Dishes": stack extra windows underneath the master windows.
 
 * "XMonad.Layout.DragPane": split the screen into two windows with a
   draggable divider.
 
+* "XMonad.Layout.DwmStyle": windows decorated in a dwm-like style.
+
 * "XMonad.Layout.Grid": put windows in a square grid.
 
+* "XMonad.Layout.HintedTile": gapless tiled layout that attempts to
+  obey window size hints.
+
+* "XMonad.Layout.IM": a layout for multi-window instant message clients.
+
 * "XMonad.Layout.LayoutCombinators": general layout combining.
 
 * "XMonad.Layout.LayoutHints": make layouts respect window size hints.
@@ -285,9 +326,6 @@ For more information on using those modules for customizing your
 
 * "XMonad.Layout.Maximize": temporarily maximize the focused window.
 
-* "XMonad.Layout.Mosaic": tries to give each window a
-  user-configurable relative area
-
 * "XMonad.Layout.MosaicAlt": give each window a specified relative
   amount of screen space.
 
@@ -301,27 +339,48 @@ For more information on using those modules for customizing your
 
 * "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis.
 
+* "XMonad.Layout.Reflect": reflect any layout vertically or horizontally.
+
 * "XMonad.Layout.ResizableTile": tiled layout allowing you to change
   width and height of windows.
 
+* "XMonad.Layout.ResizeScreen": a layout modifier to change the screen
+  geometry on one side.
+
 * "XMonad.Layout.Roledex": a \"completely pointless layout which acts
   like Microsoft's Flip 3D\".
 
+* "XMonad.Layout.ScratchWorkspace": implements a scratch workspace
+  which can be shown and hidden with keybindings.
+
+* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching.
+
+* "XMonad.Layout.SimpleDecoration": add simple decorations to windows.
+
+* "XMonad.Layout.SimpleFloat": a basic floating layout.
+
+* "XMonad.Layout.Simplest": a basic, simple layout that just lays out
+  all windows with a fullscreen geometry.  Used by
+  "XMonad.Layout.Tabbed".
+
 * "XMonad.Layout.Spiral": Fibonacci spiral layout.
 
 * "XMonad.Layout.Square": split the screen into a square area plus the rest.
 
+* "XMonad.Layout.TabBarDecoration": add a bar of tabs to any layout.
+
 * "XMonad.Layout.Tabbed": a tabbed layout.
 
 * "XMonad.Layout.ThreeColumns": a layout with three columns instead of two.
 
-* "XMonad.Layout.TilePrime": fill gaps created by resize hints.
-
 * "XMonad.Layout.ToggleLayouts": toggle between two layouts.
 
 * "XMonad.Layout.TwoPane": split the screen horizontally and show two
   windows.
 
+* "XMonad.Layout.WindowArranger": make any layout into a
+  pseudo-floating layout by allowing you to move and resize windows.
+
 * "XMonad.Layout.WindowNavigation": navigate around a workspace
   directionally instead of using mod-j\/k.
 
@@ -341,21 +400,38 @@ modules.
 
 These are the available prompts:
 
-* "XMonad.Prompt.Directory"
+* "XMonad.Prompt.AppendFile": append lines of text to a file.
 
-* "XMonad.Prompt.Layout"
+* "XMonad.Prompt.Directory": prompt for a directory.
 
-* "XMonad.Prompt.Man"
+* "XMonad.Prompt.DirExec": put a bunch of scripts you want in a
+  directory, then choose from among them with this prompt.
 
-* "XMonad.Prompt.Shell"
+* "XMonad.Prompt.Email": an example of "XMonad.Prompt.Input", send
+  simple short e-mails from a prompt.
 
-* "XMonad.Prompt.Ssh"
+* "XMonad.Prompt.Input": useful for building general actions requiring
+  input from a prompt.
 
-* "XMonad.Prompt.Window"
+* "XMonad.Prompt.Layout": choose a layout from a prompt.
 
-* "XMonad.Prompt.Workspace"
+* "XMonad.Prompt.Man": open man pages.
 
-* "XMonad.Prompt.XMonad"
+* "XMonad.Prompt.RunOrRaise": choose a program, and run it if not
+  already running, or raise its window if it is.
+
+* "XMonad.Prompt.Shell": run a shell command.
+
+* "XMonad.Prompt.Ssh": open an ssh connection.
+
+* "XMonad.Prompt.Theme": choose a decoration theme.
+
+* "XMonad.Prompt.Window": choose an open window.
+
+* "XMonad.Prompt.Workspace": choose a workspace.
+
+* "XMonad.Prompt.XMonad": perform various xmonad actions by choosing
+  one from a prompt.
 
 Usually a prompt is called by some key binding. See
 "XMonad.Doc.Extending#Editing_key_bindings", which includes examples
@@ -374,16 +450,46 @@ external utilities.
 
 A non complete list with a brief description:
 
-* "XMonad.Util.Anneal": The goal is to bring the system, from an
-  arbitrary initial state, to a state with the minimum possible
-  energy.
+* "XMonad.Util.CustomKeys": configure key bindings (see
+  "XMonad.Doc.Extending#Editing_key_bindings").
 
-* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to
-  configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings");
+* "XMonad.Util.Dmenu": a dmenu binding.
 
 * "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for
   running dzen as a xmonad status bar and dmenu as a program launcher;
 
+* "XMonad.Util.EZConfig": configure key bindings easily, including a
+  parser for writing key bindings in "M-C-x" style.
+
+* "XMonad.Util.Font": A module for abstracting a font facility over
+  Core fonts and Xft
+
+* "XMonad.Util.Invisible": a wrapper data type to store layout state
+  which should not be persisted across restarts.
+
+* "XMonad.Util.Loggers": a collection of loggers that can be used in
+  conjunction with "XMonad.Hooks.DynamicLog".
+
+* "XMonad.Util.NamedWindows": associate windows with their X titles.
+  Used by, e.g. "XMonad.Layout.Tabbed".
+
+* "XMonad.Util.Run": a collection of functions for running external
+  processes.
+
+* "XMonad.Util.Scratchpad": hotkey-launched floating terminal window.
+
+* "XMonad.Util.Themes": a collection of themes to be used with
+  floating layouts.
+
+* "XMonad.Util.Timer": set up a timer to handle deferred events.
+
+* "XMonad.Util.WindowProperties": an EDSL for specifying and matching
+  on window properties.
+
+* "XMonad.Util.WorkspaceCompare": general combinators for sorting
+  workspaces in various ways, used by several other modules which need
+  to sort workspaces (e.g. "XMonad.Hooks.DynamicLog").
+
 * "XMonad.Util.XSelection" provide utilities for using the mouse
   selection;
 
@@ -415,6 +521,8 @@ Editing key bindings means changing the 'XMonad.Core.XConfig.keys'
 field of the 'XMonad.Core.XConfig' record used by xmonad.  For
 example, you could write:
 
+>    import XMonad
+>
 >    main = xmonad $ defaultConfig { keys = myKeys }
 
 and provide an appropriate definition of @myKeys@, such as:
@@ -424,13 +532,16 @@ and provide an appropriate definition of @myKeys@, such as:
 >             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)
 >             ]
 
-This particular definition also requires importing "Graphics.X11.Xlib"
-(for the symbols such as @xK_F12@), "XMonad.Prompt",
+This particular definition also requires importing "XMonad.Prompt",
 "XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":
 
-> import Graphics.X11.Xlib
+> import XMonadPrompt
 > import ...  -- and so on
 
+For a list of the names of particular keys (such as xK_F12, and so
+on), see
+<http://hackage.haskell.org/packages/archive/X11/1.4.1/doc/html/Graphics-X11-Types.html>.
+
 Usually, rather than completely redefining the key bindings, as we did
 above, we want to simply add some new bindings and\/or remove existing
 ones.
@@ -498,17 +609,10 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
 >             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)
 >             ]
 
-
-There are other ways of defining @newKeys@; for instance,
-you could define it like this:
-
->    newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x)
-
-However, the simplest way to add new key bindings is to use some
-utilities provided by the xmonad-contrib library.  For instance,
-"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide
-useful functions for editing your key bindings.  Look, for instance, at
-'XMonad.Util.EZConfig.additionalKeys'.
+There are much simpler ways to accomplish this, however, if you are
+willing to use an extension module to help you configure your keys.
+For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both
+provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-<F12>\".
 
  -}
 
@@ -646,7 +750,6 @@ Suppose we want a list with the 'XMonad.Layout.Full',
 @~\/.xmonad\/xmonad.hs@, all the needed modules:
 
 >    import XMonad
->    import XMonad.Layouts
 >
 >    import XMonad.Layout.Tabbed
 >    import XMonad.Layout.Accordion
@@ -675,7 +778,7 @@ If we want only the tabbed layout without borders, then we may write:
 
 Our @~\/.xmonad\/xmonad.hs@ will now look like this:
 
->    import XMonad.Layouts
+>    import XMonad
 >
 >    import XMonad.Layout.Tabbed
 >    import XMonad.Layout.Accordion
@@ -759,6 +862,9 @@ Where @property@ can be:
 
 * 'XMonad.ManageHook.className': the resource class name.
 
+* 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the
+  property @somestring@.
+
 (You can retrieve the needed information using the X utility named
 @xprop@; for example, to find the resource class name, you can type
 
@@ -831,6 +937,9 @@ of the corresponding actions will be run (in the order in which they
 are defined).  This is a change from versions before 0.5, when only
 the first rule that matched was run.
 
+Finally, for additional rules and actions you can use in your
+manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers".
+
 -}
 
 {- $logHook

XMonad/Hooks/DynamicHooks.hs

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

XMonad/Hooks/DynamicLog.hs

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

XMonad/Hooks/EventHook.hs

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

XMonad/Hooks/EwmhDesktops.hs

@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.EwmhDesktops
--- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
+-- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>
 -- License      : BSD
 --
 -- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
@@ -9,23 +9,28 @@
 -- Portability  : unportable
 --
 -- Makes xmonad use the EWMH hints to tell panel applications about its
--- workspaces and the windows therein.
+-- workspaces and the windows therein. It also allows the user to interact
+-- with xmonad by clicking on panels and window lists.
 -----------------------------------------------------------------------------
 module XMonad.Hooks.EwmhDesktops (
     -- * Usage
     -- $usage
-    ewmhDesktopsLogHook
+    EwmhDesktopsHook,
+    ewmhDesktopsLogHook,
+    ewmhDesktopsLogHookCustom,
+    ewmhDesktopsLayout
     ) where
 
-import Data.List    (elemIndex, sortBy)
-import Data.Ord     (comparing)
-import Data.Maybe   (fromMaybe)
+import Data.List
+import Data.Maybe
 
 import XMonad
 import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import XMonad.Util.WorkspaceCompare
+import XMonad.Hooks.EventHook
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -34,24 +39,40 @@ import XMonad.Hooks.SetWMName
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
 -- > myLogHook :: X ()
--- > myLogHook = do ewmhDesktopsLogHook
--- >                return ()
+-- > myLogHook = ewmhDesktopsLogHook
 -- >
--- > main = xmonad defaultConfig { logHook = myLogHook }
--- 
+-- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig
+-- >
+-- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
+--
+-- 'avoidStruts' is used to automatically leave space for dock programs, and
+-- can be found in 'XMonad.Hooks.ManageDocks'.
+--
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
--- | 
+
+
+
+-- |
 -- Notifies pagers and window lists, such as those in the gnome-panel
 -- of the current state of workspaces and windows.
 ewmhDesktopsLogHook :: X ()
-ewmhDesktopsLogHook = withWindowSet $ \s -> do
-    -- Bad hack because xmonad forgets the original order of things, it seems
-    -- see http://code.google.com/p/xmonad/issues/detail?id=53
-    let ws = sortBy (comparing W.tag) $ W.workspaces s
-    let wins = W.allWindows s
+ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
+
+
+-- |
+-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
+-- user-specified function to transform the workspace list (post-sorting)
+ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()
+ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
+    sort' <- getSortByIndex
+    let ws = f $ sort' $ W.workspaces s
 
     setSupported
 
@@ -62,20 +83,79 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
     setDesktopNames (map W.tag ws)
 
     -- Current desktop
-    fromMaybe (return ()) $ do
-        n <- W.lookupWorkspace 0 s
-        i <- elemIndex n $ map W.tag ws
-        return $ setCurrentDesktop i
+    let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws
 
+    setCurrentDesktop curr
+
+    -- all windows, with focused windows last
+    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
     setClientList wins
 
     -- Per window Desktop
-    forM (zip ws [(0::Int)..]) $ \(w, wn) ->
-        forM (W.integrate' (W.stack w)) $ \win -> do
+    -- To make gnome-panel accept our xinerama stuff, we display
+    -- all visible windows on the current desktop.
+    forM_ (W.current s : W.visible s) $ \x ->
+        forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
+            setWindowDesktop win curr
+
+    forM_ (W.hidden s) $ \w ->
+        let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in
+        forM_ (W.integrate' (W.stack w)) $ \win -> do
             setWindowDesktop win wn
 
+    setActiveWindow
+
     return ()
 
+-- |
+-- Intercepts messages from pagers and similar applications and reacts on them.
+-- Currently supports:
+--
+--  * _NET_CURRENT_DESKTOP (switching desktops)
+--
+--  * _NET_WM_DESKTOP (move windows to other desktops)
+--
+--  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
+--
+ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a
+ewmhDesktopsLayout = eventHook EwmhDesktopsHook
+
+data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read )
+instance EventHook EwmhDesktopsHook where
+	handleEvent _ e@ClientMessageEvent {} = do handle e
+	handleEvent _ _ = return ()
+
+handle :: Event -> X ()
+handle ClientMessageEvent {
+               ev_window = w,
+               ev_message_type = mt,
+               ev_data = d
+       } = withWindowSet $ \s -> do
+       sort' <- getSortByIndex
+       let ws = sort' $ W.workspaces s
+
+       a_cd <- getAtom "_NET_CURRENT_DESKTOP"
+       a_d <- getAtom "_NET_WM_DESKTOP"
+       a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+       a_cw <- getAtom "_NET_CLOSE_WINDOW"
+       if  mt == a_cd then do
+               let n = fromIntegral (head d)
+               if 0 <= n && n < length ws then
+                       windows $ W.view (W.tag (ws !! n))
+                 else  trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n
+        else if mt == a_d then do
+               let n = fromIntegral (head d)
+               if 0 <= n && n < length ws then
+                       windows $ W.shiftWin (W.tag (ws !! n)) w
+                 else  trace $ "Bad _NET_DESKTOP with data[0]="++show n
+        else if mt == a_aw then do
+               windows $ W.focusWindow w
+        else if mt == a_cw then do
+               windows $ W.focusWindow w
+               kill
+        else trace $ "Unknown ClientMessageEvent " ++ show mt
+handle _ = undefined -- does not happen, as otherwise ewmhDesktopsHook would not match
+
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do
@@ -98,7 +178,7 @@ setDesktopNames names = withDisplay $ \dpy -> do
     a <- getAtom "_NET_DESKTOP_NAMES"
     c <- getAtom "UTF8_STRING"
     let names' = map (fromIntegral.fromEnum) $
-            concatMap (("Workspace "++) . (++['\0'])) names
+            concatMap (++['\0']) names
     io $ changeProperty8 dpy r a c propModeReplace names'
 
 setClientList :: [Window] -> X ()
@@ -122,9 +202,24 @@ setSupported = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_SUPPORTED"
     c <- getAtom "ATOM"
-    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]
+    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
+                         ,"_NET_NUMBER_OF_DESKTOPS"
+                         ,"_NET_CLIENT_LIST"
+                         ,"_NET_CLIENT_LIST_STACKING"
+                         ,"_NET_CURRENT_DESKTOP"
+                         ,"_NET_DESKTOP_NAMES"
+                         ,"_NET_ACTIVE_WINDOW"
+                         ,"_NET_WM_DESKTOP"
+                         ,"_NET_WM_STRUT"
+                         ]
     io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
 
     setWMName "xmonad"
 
-
+setActiveWindow :: X ()
+setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
+    let w = fromMaybe none (W.peek s)
+    r <- asks theRoot
+    a <- getAtom "_NET_ACTIVE_WINDOW"
+    c <- getAtom "WINDOW"
+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]

XMonad/Hooks/FadeInactive.hs

@@ -0,0 +1,75 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.FadeInactive
+-- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com>
+-- License      : BSD
+--
+-- Maintainer   : Justin Bogner <mail@justinbogner.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,
+-- which causes those windows to become slightly translucent if something
+-- like xcompmgr is running
+-----------------------------------------------------------------------------
+module XMonad.Hooks.FadeInactive (
+    -- * Usage
+    -- $usage
+    fadeInactiveLogHook
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import Control.Monad (forM_)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Hooks.FadeInactive
+-- >
+-- > myLogHook :: X ()
+-- > myLogHook = fadeInactiveLogHook fadeAmount
+-- >     where fadeAmount = 0xdddddddd
+-- >
+-- > main = xmonad defaultConfig { logHook = myLogHook }
+--
+-- fadeAmount can be any integer
+-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
+-- or something similar for this to do anything
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- |
+-- sets the opacity of a window
+setOpacity :: Window -> Integer -> X ()
+setOpacity w t = withDisplay $ \dpy -> do
+    a <- getAtom "_NET_WM_WINDOW_OPACITY"
+    c <- getAtom "CARDINAL"
+    io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t]
+
+-- |
+-- fades a window out by setting the opacity
+fadeOut :: Integer -> Window -> X ()
+fadeOut amt = flip setOpacity amt
+
+-- |
+-- makes a window completely opaque
+fadeIn :: Window -> X ()
+fadeIn = flip setOpacity 0xffffffff
+
+-- |
+-- lowers the opacity of inactive windows to the specified amount
+fadeInactiveLogHook :: Integer -> X ()
+fadeInactiveLogHook amt = withWindowSet $ \s ->
+    forM_ (concatMap visibleWins $ W.current s : W.visible s) (fadeOut amt) >>
+    withFocused fadeIn
+        where
+          visibleWins = maybe [] unfocused . W.stack . W.workspace
+          unfocused (W.Stack _ l r) = l ++ r

XMonad/Hooks/ManageDocks.hs

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

XMonad/Hooks/ManageHelpers.hs

@@ -0,0 +1,167 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ManageHelpers
+-- Copyright    : (c) Lukas Mai
+-- License      : BSD
+--
+-- Maintainer   : Lukas Mai <l.mai@web.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- This module provides helper functions to be used in @manageHook@. Here's
+-- how you might use this:
+--
+-- > import XMonad.Hooks.ManageHelpers
+-- > main =
+-- >     xmonad defaultConfig{
+-- >         ...
+-- >         manageHook = composeOne [
+-- >             isKDETrayWindow -?> doIgnore,
+-- >             transience,
+-- >             isFullscreen -?> doFullFloat,
+-- >             resource =? "stalonetray" -?> doIgnore
+-- >         ],
+-- >         ...
+-- >     }
+
+module XMonad.Hooks.ManageHelpers (
+    composeOne,
+    (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),
+    isKDETrayWindow,
+    isFullscreen,
+    transientTo,
+    maybeToDefinite,
+    MaybeManageHook,
+    transience,
+    transience',
+    doRectFloat,
+    doFullFloat,
+    doCenterFloat
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Data.Maybe
+import Data.Monoid
+
+-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe
+type MaybeManageHook = Query (Maybe (Endo WindowSet))
+-- | A grouping type, which can hold the outcome of a predicate Query.
+-- This is analogous to group types in regular expressions.
+-- TODO: create a better API for aggregating multiple Matches logically
+data Match a = Match Bool a
+
+-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
+-- a candidate returns a 'Just' value, effectively running only the first match
+-- (whereas 'composeAll' continues and executes all matching rules).
+composeOne :: [MaybeManageHook] -> ManageHook
+composeOne = foldr try idHook
+    where
+    try q z = do
+        x <- q
+        case x of
+            Just h -> return h
+            Nothing -> z
+
+infixr 0 -?>, -->>, -?>>
+
+-- | q \/=? x. if the result of q equals x, return False
+(/=?) :: Eq a => Query a -> a -> Query Bool
+q /=? x = fmap (/= x) q
+
+-- | q <==? x. if the result of q equals x, return True grouped with q
+(<==?) :: Eq a => Query a -> a -> Query (Match a)
+q <==? x = fmap (`eq` x) q
+    where
+    eq q' x' = Match (q' == x') q'
+
+-- | q <\/=? x. if the result of q notequals x, return True grouped with q
+(</=?) :: Eq a => Query a -> a -> Query (Match a)
+q </=? x = fmap (`neq` x) q
+    where
+    neq q' x' = Match (q' /= x') q'
+
+-- | A helper operator for use in 'composeOne'. It takes a condition and an action;
+-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
+-- go on and try the next rule.
+(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
+p -?> f = do
+    x <- p
+    if x then fmap Just f else return Nothing
+
+-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.
+(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
+p -->> f = do
+    Match b m <- p
+    if b then (f m) else mempty
+
+-- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
+(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
+p -?>> f = do
+    Match b m <- p
+    if b then fmap  Just (f m) else return Nothing
+
+-- | A predicate to check whether a window is a KDE system tray icon.
+isKDETrayWindow :: Query Bool
+isKDETrayWindow = ask >>= \w -> liftX $ do
+    dpy <- asks display
+    kde_tray <- getAtom "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR"
+    r <- io $ getWindowProperty32 dpy kde_tray w
+    return $ case r of
+        Just [_] -> True
+        _ -> False
+
+-- | A predicate to check whether a window wants to fill the whole screen.
+-- See also 'doFullFloat'.
+isFullscreen :: Query Bool
+isFullscreen = ask >>= \w -> liftX $ do
+    dpy <- asks display
+    state <- getAtom "_NET_WM_STATE"
+    full <- getAtom "_NET_WM_STATE_FULLSCREEN"
+    r <- io $ getWindowProperty32 dpy state w
+    return $ case r of
+        Just xs -> fromIntegral full `elem` xs
+        _ -> False
+
+-- | A predicate to check whether a window is Transient.
+-- It holds the result which might be the window it is transient to
+-- or it might be 'Nothing'.
+transientTo :: Query (Maybe Window)
+transientTo = do
+    w <- ask
+    d <- (liftX . asks) display
+    liftIO $ getTransientForHint d w
+
+-- | A convenience 'MaybeManageHook' that will check to see if a window
+-- is transient, and then move it to its parent.
+transience :: MaybeManageHook
+transience = transientTo </=? Nothing -?>> move
+    where
+    move mw = maybe idHook (doF . move') mw
+    move' w s = maybe s (`W.shift` s) (W.findTag w s)
+
+-- | 'transience' set to a 'ManageHook'
+transience' :: ManageHook
+transience' = maybeToDefinite transience
+
+-- | converts 'MaybeManageHook's to 'ManageHook's
+maybeToDefinite :: MaybeManageHook -> ManageHook
+maybeToDefinite = fmap (fromMaybe mempty)
+
+
+-- | Floats the new window in the given rectangle.
+doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.
+            -> ManageHook
+doRectFloat r = ask >>= \w -> doF (W.float w r)
+
+-- | Floats the window and makes it use the whole screen. Equivalent to
+-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.
+doFullFloat :: ManageHook
+doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1
+
+-- | Floats a new window with its original size, but centered.
+doCenterFloat :: ManageHook
+doCenterFloat = ask >>= \w -> doF . W.float w . center . snd =<< liftX (floatLocation w)
+    where
+    center (W.RationalRect _ _ w h) = W.RationalRect ((1-w)/2) ((1-h)/2) w h

XMonad/Hooks/Script.hs

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

XMonad/Hooks/ServerMode.hs

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

XMonad/Hooks/SetWMName.hs

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

XMonad/Hooks/UrgencyHook.hs

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

XMonad/Layout/BoringWindows.hs

@@ -0,0 +1,67 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.BoringWindows
+-- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  none
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- BoringWindows is an extension to allow windows to be marked boring
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BoringWindows (
+                                   -- * Usage
+                                   -- $usage
+                                   boringWindows,
+                                   markBoring, clearBoring,
+                                   focusUp, focusDown
+                                  ) where
+
+import XMonad hiding (Point)
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Invisible
+
+data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring
+                       deriving ( Read, Show, Typeable )
+instance Message BoringMessage
+
+markBoring, clearBoring, focusUp, focusDown :: X ()
+markBoring = withFocused (sendMessage . IsBoring)
+clearBoring = sendMessage ClearBoring
+focusUp = sendMessage FocusUp
+focusDown = sendMessage FocusDown
+
+data BoringWindows a = BoringWindows (Invisible [] a) deriving ( Show, Read, Typeable )
+
+boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
+boringWindows = ModifiedLayout (BoringWindows (I []))
+
+instance LayoutModifier BoringWindows Window where
+    handleMessOrMaybeModifyIt (BoringWindows (I bs)) m
+        | Just (IsBoring b) <- fromMessage m = return $ Just $ Left $ BoringWindows (I (b:bs))
+        | Just ClearBoring <- fromMessage m = return $ Just $ Left $ BoringWindows (I [])
+        | Just FocusUp <- fromMessage m = do windows $ W.modify' $ focusUp'
+                                             return Nothing
+        | Just FocusDown <- fromMessage m =
+                            do windows $ W.modify' (reverseStack . focusUp' . reverseStack)
+                               return Nothing
+        where focusUp' (W.Stack t ls rs)
+                  | (a,l:ls') <- skipBoring ls = W.Stack l ls' (a++t:rs)
+                  | otherwise = case skipBoring (reverse (t:rs)++ls) of
+                                (a,x:xs) -> W.Stack x xs a
+                                _ -> W.Stack t ls rs
+              skipBoring [] = ([],[])
+              skipBoring (x:xs) | x `elem` bs = case skipBoring xs of
+                                                (a,b) -> (x:a,b)
+                                | otherwise = ([],x:xs)
+    handleMessOrMaybeModifyIt _ _ = return Nothing
+
+-- | reverse a stack: up becomes down and down becomes up.
+reverseStack :: W.Stack a -> W.Stack a
+reverseStack (W.Stack t ls rs) = W.Stack t rs ls

XMonad/Layout/Combo.hs

@@ -6,8 +6,8 @@
 -- Module      :  XMonad.Layout.Combo
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
+--
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -17,7 +17,7 @@
 
 module XMonad.Layout.Combo (
                             -- * Usage
-                            -- $usage 
+                            -- $usage
                             combineTwo,
                             CombineTwo
                            ) where
@@ -25,17 +25,17 @@ module XMonad.Layout.Combo (
 import Data.List ( delete, intersect, (\\) )
 import Data.Maybe ( isJust )
 import XMonad hiding (focus)
-import XMonad.StackSet ( integrate, Stack(..) )
+import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )
 import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
 import qualified XMonad.StackSet as W ( differentiate )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--- 
--- > import XMonad.Layout.Combo 
--- 
+--
+-- > import XMonad.Layout.Combo
+--
 -- and add something like
--- 
+--
 -- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
 --
 -- to your layouts.
@@ -99,9 +99,9 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
                          s1 = differentiate f' (origws \\ w2')
                          s2 = differentiate f' w2'
                          f' = focus s:delete (focus s) f
-                     ([((),r1),((),r2)], msuper') <- doLayout super rinput superstack
-                     (wrs1, ml1') <- runLayout l1 r1 s1
-                     (wrs2, ml2') <- runLayout l2 r2 s2
+                     ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput
+                     (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
+                     (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
                      return (wrs1++wrs2, Just $ C2 f' w2'
                                      (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))
     handleMessage (C2 f ws2 super l1 l2) m

XMonad/Layout/Decoration.hs

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

XMonad/Layout/DecorationMadness.hs

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

XMonad/Layout/DragPane.hs

@@ -4,13 +4,12 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.DragPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 --                    David Roundy <droundy@darcs.net>,
 --                    Andrea Rossato <andrea.rossato@unibz.it>
 -- License     :  BSD3-style (see LICENSE)
 -- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
---                Andrea Rossato <andrea.rossato@unibz.it>
+-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -107,7 +106,7 @@ doLay mirror (DragPane mw ty delta split) r s = do
                                mirror $ Rectangle x y (w-halfHandleWidth) h
       right = case right' of
                 Rectangle x y w h ->
-		    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
+                    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
       handr = case left' of
                 Rectangle x y w h ->
                     mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
@@ -131,6 +130,8 @@ doLay mirror (DragPane mw ty delta split) r s = do
 newDragWin :: Rectangle -> X Window
 newDragWin r = do
   let mask = Just $ exposureMask .|. buttonPressMask
-  w <- createNewWindow r mask handleColor
+  w <- createNewWindow r mask handleColor False
   showWindow  w
+  d <- asks display
+  liftIO $ lowerWindow d w
   return      w

XMonad/Layout/DwmStyle.hs

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

XMonad/Layout/Gaps.hs

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

XMonad/Layout/Grid.hs

@@ -17,7 +17,7 @@
 module XMonad.Layout.Grid (
     -- * Usage
     -- $usage
-	Grid(..)
+    Grid(..), arrange
 ) where
 
 import XMonad
@@ -44,23 +44,23 @@ instance LayoutClass Grid a where
 
 arrange :: Rectangle -> [a] -> [(a, Rectangle)]
 arrange (Rectangle rx ry rw rh) st = zip st rectangles
+    where
+    nwins = length st
+    ncols = max 1 . round . sqrt $ fromIntegral nwins * 9 * fromIntegral rw / (16 * fromIntegral rh :: Double)
+    mincs = nwins `div` ncols
+    extrs = nwins - ncols * mincs
+    chop :: Int -> Dimension -> [(Position, Dimension)]
+    chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
         where
-        nwins = length st
-        ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins
-        mincs = nwins `div` ncols
-        extrs = nwins - ncols * mincs
-        chop :: Int -> Dimension -> [(Position, Dimension)]
-        chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
-                where
-                k :: Dimension
-                k = m `div` fromIntegral n
-                m' = fromIntegral m
-                k' :: Position
-                k' = fromIntegral k
-        xcoords = chop ncols rw
-        ycoords = chop mincs rh
-        ycoords' = chop (succ mincs) rh
-        (xbase, xext) = splitAt (ncols - extrs) xcoords
-        rectangles = combine ycoords xbase ++ combine ycoords' xext
-                where
-                combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]
+        k :: Dimension
+        k = m `div` fromIntegral n
+        m' = fromIntegral m
+        k' :: Position
+        k' = fromIntegral k
+    xcoords = chop ncols rw
+    ycoords = chop mincs rh
+    ycoords' = chop (succ mincs) rh
+    (xbase, xext) = splitAt (ncols - extrs) xcoords
+    rectangles = combine ycoords xbase ++ combine ycoords' xext
+        where
+        combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]

XMonad/Layout/HintedGrid.hs

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

XMonad/Layout/HintedTile.hs

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

XMonad/Layout/IM.hs

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

XMonad/Layout/LayoutCombinators.hs

@@ -6,46 +6,54 @@
 -- Copyright    : (c) David Roundy <droundy@darcs.net>
 -- License      : BSD
 --
--- Maintainer   : David Roundy <droundy@darcs.net>
+-- Maintainer   : none
 -- Stability    : unstable
 -- Portability  : portable
 --
--- A module for combining other layouts.
+-- The "XMonad.Layout.LayoutCombinators" module provides combinators
+-- for easily combining multiple layouts into one composite layout, as
+-- well as a way to jump directly to any particular layout (say, with
+-- a keybinding) without having to cycle through other layouts to get
+-- to it.
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.LayoutCombinators (
-    -- * Usage
-    -- $usage
+module XMonad.Layout.LayoutCombinators
+    ( -- * Usage
+      -- $usage
 
-    -- * Combinators using DragPane vertical
-    -- $dpv
-    (*||*), (**||*),(***||*),(****||*),(***||**),(****||***),
-    (***||****),(*||****),(**||***),(*||***),(*||**),
+      -- * Layout combinators
+      -- $combine
 
-    -- * Combinators using DragPane horizontal
-    -- $dph
-    (*//*), (**//*),(***//*),(****//*),(***//**),(****//***),
-    (***//****),(*//****),(**//***),(*//***),(*//**),
+      -- ** Combinators using DragPane vertical
+      -- $dpv
+      (*||*), (**||*),(***||*),(****||*),(***||**),(****||***)
+    , (***||****),(*||****),(**||***),(*||***),(*||**)
 
-    -- * Combinators using Tall (vertical)
-    -- $tv
-    (*|*), (**|*),(***|*),(****|*),(***|**),(****|***),
-    (***|****),(*|****),(**|***),(*|***),(*|**),
+      -- ** Combinators using DragPane horizontal
+      -- $dph
+    , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)
+    , (***//****),(*//****),(**//***),(*//***),(*//**)
 
-    -- * Combinators using Mirror Tall (horizontal)
-    -- $mth
-    (*/*), (**/*),(***/*),(****/*),(***/**),(****/***),
-    (***/****),(*/****),(**/***),(*/***),(*/**),
+      -- ** Combinators using Tall (vertical)
+      -- $tv
+    , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)
+    , (***|****),(*|****),(**|***),(*|***),(*|**)
 
-    -- * A new combinator
-    -- $nc
-    (|||),
-    JumpToLayout(JumpToLayout)
+      -- ** Combinators using Mirror Tall (horizontal)
+      -- $mth
+    , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)
+    , (***/****),(*/****),(**/***),(*/***),(*/**)
+
+      -- * New layout choice combinator and 'JumpToLayout'
+      -- $jtl
+    , (|||)
+    , JumpToLayout(JumpToLayout)
     ) where
 
 import Data.Maybe ( isJust, isNothing )
 
 import XMonad hiding ((|||))
+import XMonad.StackSet (Workspace (..))
 import XMonad.Layout.Combo
 import XMonad.Layout.DragPane
 
@@ -54,14 +62,34 @@ import XMonad.Layout.DragPane
 --
 -- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )
 --
--- Then edit your @layoutHook@ by using the new layout combinators:
+-- Then edit your @layoutHook@ to use the new layout combinators. For
+-- example:
 --
 -- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full)  ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
--- For more detailed instructions on editing the layoutHook see:
+-- For more detailed instructions on editing the @layoutHook@ see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- To use the 'JumpToLayout' message, hide the normal @|||@ operator instead:
+--
+-- > import XMonad hiding ( (|||) )
+-- > import XMonad.Layout.LayoutCombinators
+--
+-- Then bind some keys to a 'JumpToLayout' message:
+--
+-- >   , ((modMask x .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")  -- jump directly to the Full layout
+--
+-- See below for more detailed documentation.
+
+-- $combine
+-- Each of the following combinators combines two layouts into a
+-- single composite layout by splitting the screen into two regions,
+-- one governed by each layout.  Asterisks in the combinator names
+-- denote the relative amount of screen space given to the respective
+-- layouts.  For example, the '***||*' combinator gives three times as
+-- much space to the left-hand layout as to the right-hand layout.
 
 infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**,
          *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**,
@@ -71,6 +99,7 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
 -- $dpv
 -- These combinators combine two layouts using "XMonad.DragPane" in
 -- vertical mode.
+
 (*||*),(**||*),(***||*),(****||*), (***||**),(****||***),
        (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
           l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
@@ -90,6 +119,7 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
 -- $dph
 -- These combinators combine two layouts using "XMonad.DragPane" in
 -- horizontal mode.
+
 (*//*),(**//*),(***//*),(****//*), (***//**),(****//***),
        (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>
           l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a
@@ -107,7 +137,8 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
 (*//**)     = combineTwo (dragPane Horizontal 0.1 (1/3))
 
 -- $tv
--- These combinators combine two layouts vertically using Tall.
+-- These combinators combine two layouts vertically using @Tall@.
+
 (*|*),(**|*),(***|*),(****|*), (***|**),(****|***),
        (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)
           => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a
@@ -125,8 +156,9 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
 
 
 -- $mth
--- These combinators combine two layouts horizontally using Mirror
--- Tall (a wide layout).
+-- These combinators combine two layouts horizontally using @Mirror
+-- Tall@.
+
 (*/*),(**/*),(***/*),(****/*), (***/**),(****/***),
        (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)
           => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a
@@ -144,9 +176,39 @@ infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, *
 
 infixr 5 |||
 
--- $nc
--- A new layout combinator that allows the use of a prompt to change
--- layout. For more information see "Xmonad.Prompt.Layout"
+-- $jtl
+-- The standard xmonad core exports a layout combinator @|||@ which
+-- represents layout choice.  This is a reimplementation which also
+-- provides the capability to support 'JumpToLayout' messages.  To use
+-- it, be sure to hide the import of @|||@ from the xmonad core:
+--
+-- > import XMonad hiding ( (|||) )
+--
+-- The argument given to a 'JumpToLayout' message should be the
+-- @description@ of the layout to be selected.  If you use
+-- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed
+-- in your status bar.  Alternatively, you can use GHCi to determine
+-- the proper name to use.  For example:
+--
+-- > $ ghci
+-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
+-- > Loading package base ... linking ... done.
+-- > :set prompt "> "    -- don't show loaded module names
+-- > > :m +XMonad.Core   -- load the xmonad core
+-- > > :m +XMonad.Layout.Grid  -- load whatever module you want to use
+-- > > description Grid  -- find out what it's called
+-- > "Grid"
+--
+-- As yet another (possibly easier) alternative, you can use the
+-- "XMonad.Layout.Named" modifier to give custom names to your
+-- layouts, and use those.
+--
+-- For the ability to select a layout from a prompt, see
+-- "Xmonad.Prompt.Layout".
+
+-- | A reimplementation of the combinator of the same name from the
+--   xmonad core, providing layout choice, and the ability to support
+--   'JumpToLayout' messages.
 (|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a
 (|||) = NewSelect True
 
@@ -155,14 +217,17 @@ data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )
 data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable )
 instance Message NoWrap
 
+-- | A message to jump to a particular layout, specified by its
+--   description string.
 data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable )
 instance Message JumpToLayout
 
 instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
-    doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s
-                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
-    doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s
-                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
+    runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r
+                                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
+
+    runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r
+                                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
     description (NewSelect True l1 _) = description l1
     description (NewSelect False _ l2) = description l2
     handleMessage l@(NewSelect False _ _) m
@@ -213,4 +278,3 @@ passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
 
 when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
 when' f a b = do a1 <- a; if f a1 then b else return a1
-

XMonad/Layout/LayoutHints.hs

@@ -6,21 +6,23 @@
 -- Copyright    : (c) David Roundy <droundy@darcs.net>
 -- License      : BSD
 --
--- Maintainer   : David Roundy <droundy@darcs.net>
+-- Maintainer   : none
 -- Stability    : unstable
 -- Portability  : portable
 --
 -- Make layouts respect size hints.
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.LayoutHints (
-    -- * usage
-    -- $usage
-    layoutHints,
-    LayoutHints) where
+module XMonad.Layout.LayoutHints
+    ( -- * usage
+      -- $usage
+      layoutHints
+    , LayoutHints
+    ) where
 
 import XMonad hiding ( trace )
 import XMonad.Layout.LayoutModifier
+import XMonad.Layout.Decoration ( isInStack )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -40,22 +42,15 @@ import XMonad.Layout.LayoutModifier
 layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
 layoutHints = ModifiedLayout LayoutHints
 
--- | Expand a size by the given multiple of the border width.  The
--- multiple is most commonly 1 or -1.
-adjBorders                :: Dimension -> Dimension -> D -> D
-adjBorders bW mult (w,h)  = (w+2*mult*bW, h+2*mult*bW)
-
 data LayoutHints a = LayoutHints deriving (Read, Show)
 
 instance LayoutModifier LayoutHints Window where
     modifierDescription _ = "Hinted"
-    redoLayout _ _ _ xs = do
-                            bW <- asks (borderWidth . config)
-                            xs' <- mapM (applyHint bW) xs
+    redoLayout _ _ s xs = do
+                            xs' <- mapM applyHint xs
                             return (xs', Nothing)
      where
-        applyHint bW (w,Rectangle a b c d) =
-            withDisplay $ \disp -> do
-                sh <- io $ getWMNormalHints disp w
-                let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d)
-                return (w, Rectangle a b c' d')
+        applyHint (w,r@(Rectangle a b c d)) = do
+            adj <- mkAdjust w
+            let (c',d') = adj (c,d)
+            return (w, if isInStack s w then Rectangle a b c' d' else r)

XMonad/Layout/LayoutModifier.hs

@@ -7,58 +7,263 @@
 -- Copyright    : (c) David Roundy <droundy@darcs.net>
 -- License      : BSD
 --
--- Maintainer   : David Roundy <droundy@darcs.net>
+-- Maintainer   : none
 -- Stability    : unstable
 -- Portability  : portable
 --
--- A module for writing easy Llayouts and layout modifiers
+-- A module for writing easy layout modifiers, which do not define a
+-- layout in and of themselves, but modify the behavior of or add new
+-- functionality to other layouts.  If you ever find yourself writing
+-- a layout which takes another layout as a parameter, chances are you
+-- should be writing a LayoutModifier instead!
+--
+-- In case it is not clear, this module is not intended to help you
+-- configure xmonad, it is to help you write other extension modules.
+-- So get hacking!
 -----------------------------------------------------------------------------
 
 module XMonad.Layout.LayoutModifier (
     -- * Usage
     -- $usage
+
+    -- * The 'LayoutModifier' class
     LayoutModifier(..), ModifiedLayout(..)
     ) where
 
 import XMonad
-import XMonad.StackSet ( Stack )
+import XMonad.StackSet ( Stack, Workspace (..) )
 
 -- $usage
--- Use LayoutModifier to help write easy Layouts.
 --
--- LayouModifier defines a class 'LayoutModifier'. Each method as a
--- default implementation.
+-- The 'LayoutModifier' class is provided to help extension developers
+-- write easy layout modifiers.  End users won't find much of interest
+-- here. =)
 --
--- For usage examples you can see "XMonad.Layout.WorkspaceDir",
--- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder",
+-- To write a layout modifier using the 'LayoutModifier' class, define
+-- a data type to represent the layout modification (storing any
+-- necessary state), define an instance of 'LayoutModifier', and
+-- export an appropriate function for applying the modifier.  For example:
+--
+-- > data MyModifier a = MyModifier MyState
+-- >   deriving (Show, Read)
+-- >
+-- > instance LayoutModifier MyModifier a where
+-- >   -- override whatever methods from LayoutModifier you like
+-- >
+-- > modify :: l a -> ModifiedLayout MyModifier l a
+-- > modify = ModifiedLayout (MyModifier initialState)
+--
+-- When defining an instance of 'LayoutModifier', you are free to
+-- override as many or as few of the methods as you see fit.  See the
+-- documentation below for specific information about the effect of
+-- overriding each method.  Every method has a default implementation;
+-- an instance of 'LayoutModifier' which did not provide a non-default
+-- implementation of any of the methods would simply act as the
+-- identity on any layouts to which it is applied.
+--
+-- For more specific usage examples, see
+--
+-- * "XMonad.Layout.WorkspaceDir"
+--
+-- * "XMonad.Layout.Magnifier"
+--
+-- * "XMonad.Layout.NoBorders"
+--
+-- * "XMonad.Layout.Reflect"
+--
+-- * "XMonad.Layout.Named"
+--
+-- * "XMonad.Layout.WindowNavigation"
+--
+-- and several others.  You probably want to start by looking at some
+-- of the above examples; the documentation below is detailed but
+-- possibly confusing, and in many cases the creation of a
+-- 'LayoutModifier' is actually quite simple.
+--
+-- /Important note/: because of the way the 'LayoutModifier' class is
+-- intended to be used, by overriding any of its methods and keeping
+-- default implementations for all the others, 'LayoutModifier'
+-- methods should never be called explicitly.  It is likely that such
+-- explicit calls will not have the intended effect.  Rather, the
+-- 'LayoutModifier' methods should only be called indirectly through
+-- the 'LayoutClass' instance for 'ModifiedLayout', since it is this
+-- instance that defines the semantics of overriding the various
+-- 'LayoutModifier' methods.
 
 class (Show (m a), Read (m a)) => LayoutModifier m a where
+
+    -- | 'modifyLayout' allows you to intercept a call to 'runLayout'
+    --   /before/ it is called on the underlying layout, in order to
+    --   perform some effect in the X monad, and\/or modify some of
+    --   the parameters before passing them on to the 'runLayout'
+    --   method of the underlying layout.
+    --
+    --   The default implementation of 'modifyLayout' simply calls
+    --   'runLayout' on the underlying layout.
+    modifyLayout :: (LayoutClass l a) =>
+                    m a                             -- ^ the layout modifier
+                 -> Workspace WorkspaceId (l a) a   -- ^ current workspace
+                 -> Rectangle                       -- ^ screen rectangle
+                 -> X ([(a, Rectangle)], Maybe (l a))
+    modifyLayout _ w r = runLayout w r
+
+    -- | 'handleMess' allows you to spy on messages to the underlying
+    --   layout, in order to have an effect in the X monad, or alter
+    --   the layout modifier state in some way (by returning @Just
+    --   nm@, where @nm@ is a new modifier).  In all cases, the
+    --   underlying layout will also receive the message as usual,
+    --   after the message has been processed by 'handleMess'.
+    --
+    --   If you wish to possibly modify a message before it reaches
+    --   the underlying layout, you should use
+    --   'handleMessOrMaybeModifyIt' instead.  If you do not need to
+    --   modify messages or have access to the X monad, you should use
+    --   'pureMess' instead.
+    --
+    --   The default implementation of 'handleMess' calls 'unhook'
+    --   when receiving a 'Hide' or 'ReleaseResources' method (after
+    --   which it returns @Nothing@), and otherwise passes the message
+    --   on to 'pureMess'.
     handleMess :: m a -> SomeMessage -> X (Maybe (m a))
     handleMess m mess | Just Hide <- fromMessage mess             = doUnhook
                       | Just ReleaseResources <- fromMessage mess = doUnhook
-                      | otherwise = return Nothing
+                      | otherwise = return $ pureMess m mess
      where doUnhook = do unhook m; return Nothing
+
+    -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages
+    --   sent to the underlying layout, in order to have an effect in
+    --   the X monad, alter the layout modifier state, or produce a
+    --   modified message to be passed on to the underlying layout.
+    --
+    --   The default implementation of 'handleMessOrMaybeModifyIt'
+    --   simply passes on the message to 'handleMess'.
     handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
     handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
                                           return (Left `fmap` mm')
-    redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
+
+    -- | 'pureMess' allows you to spy on messages sent to the
+    --   underlying layout, in order to possibly change the layout
+    --   modifier state.
+    --
+    --   The default implementation of 'pureMess' ignores messages
+    --   sent to it, and returns @Nothing@ (causing the layout
+    --   modifier to remain unchanged).
+    pureMess :: m a -> SomeMessage -> Maybe (m a)
+    pureMess _ _ = Nothing
+
+    -- | 'redoLayout' allows you to intercept a call to 'runLayout' on
+    --   workspaces with at least one window, /after/ it is called on
+    --   the underlying layout, in order to perform some effect in the
+    --   X monad, possibly return a new layout modifier, and\/or
+    --   modify the results of 'runLayout' before returning them.
+    --
+    --   If you don't need access to the X monad, use 'pureModifier'
+    --   instead.  Also, if the behavior you need can be cleanly
+    --   separated into an effect in the X monad, followed by a pure
+    --   transformation of the results of 'runLayout', you should
+    --   consider implementing 'hook' and 'pureModifier' instead of
+    --   'redoLayout'.
+    --
+    --   If you also need to perform some action when 'runLayout' is
+    --   called on an empty workspace, see 'emptyLayoutMod'.
+    --
+    --   The default implementation of 'redoLayout' calls 'hook' and
+    --   then 'pureModifier'.
+    redoLayout :: m a          -- ^ the layout modifier
+               -> Rectangle    -- ^ screen rectangle
+               -> Stack a      -- ^ current window stack
+               -> [(a, Rectangle)]  -- ^ (window,rectangle) pairs returned
+                                    -- by the underlying layout
                -> X ([(a, Rectangle)], Maybe (m a))
-    redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)
+    redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs
+
+    -- | 'pureModifier' allows you to intercept a call to 'runLayout'
+    --   /after/ it is called on the underlying layout, in order to
+    --   modify the list of window\/rectangle pairings it has returned,
+    --   and\/or return a new layout modifier.
+    --
+    --   The default implementation of 'pureModifier' returns the
+    --   window rectangles unmodified.
+    pureModifier :: m a        -- ^ the layout modifier
+                 -> Rectangle  -- ^ screen rectangle
+                 -> Stack a    -- ^ current window stack
+                 -> [(a, Rectangle)]  -- ^ (window, rectangle) pairs returned
+                                      -- by the underlying layout
+                 -> ([(a, Rectangle)], Maybe (m a))
+    pureModifier _ _ _ wrs = (wrs, Nothing)
+
+    -- | 'emptyLayoutMod' allows you to intercept a call to
+    --   'runLayout' on an empty workspace, /after/ it is called on
+    --   the underlying layout, in order to perform some effect in the
+    --   X monad, possibly return a new layout modifier, and\/or
+    --   modify the results of 'runLayout' before returning them.
+    --
+    --   If you don't need access to the X monad, then tough luck.
+    --   There isn't a pure version of 'emptyLayoutMod'.
+    --
+    --   The default implementation of 'emptyLayoutMod' ignores its
+    --   arguments and returns an empty list of window\/rectangle
+    --   pairings.
+    --
+    --   /NOTE/: 'emptyLayoutMod' will likely be combined with
+    --   'redoLayout' soon!
+    emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)]
+                   -> X ([(a, Rectangle)], Maybe (m a))
+    emptyLayoutMod _ _ _ = return ([], Nothing)
+
+    -- | 'hook' is called by the default implementation of
+    --   'redoLayout', and as such represents an X action which is to
+    --   be run each time 'runLayout' is called on the underlying
+    --   layout, /after/ 'runLayout' has completed.  Of course, if you
+    --   override 'redoLayout', then 'hook' will not be called unless
+    --   you explicitly call it.
+    --
+    --   The default implementation of 'hook' is @return ()@ (i.e., it
+    --   has no effect).
     hook :: m a -> X ()
     hook _ = return ()
+
+    -- | 'unhook' is called by the default implementation of
+    --   'handleMess' upon receiving a 'Hide' or a 'ReleaseResources'
+    --   message.
+    --
+    --   The default implementation, of course, does nothing.
     unhook :: m a -> X ()
     unhook _ = return ()
+
+    -- | 'modifierDescription' is used to give a String description to
+    --   this layout modifier.  It is the empty string by default; you
+    --   should only override this if it is important that the
+    --   presence of the layout modifier be displayed in text
+    --   representations of the layout (for example, in the status bar
+    --   of a "XMonad.Hooks.DynamicLog" user).
     modifierDescription :: m a -> String
     modifierDescription = const ""
 
+    -- | 'modifyDescription' gives a String description for the entire
+    --   layout (modifier + underlying layout).  By default, it is
+    --   derived from the concatenation of the 'modifierDescription'
+    --   with the 'description' of the underlying layout, with a
+    --   \"smart space\" in between (the space is not included if the
+    --   'modifierDescription' is empty).
+    modifyDescription :: (LayoutClass l a) => m a -> l a -> String
+    modifyDescription m l = modifierDescription m <> description l
+        where "" <> x = x
+              x <> y = x ++ " " ++ y
+
+-- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the
+--   semantics of a 'LayoutModifier' applied to an underlying layout.
 instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
-    doLayout (ModifiedLayout m l) r s =
-        do (ws, ml') <- doLayout l r s
-           (ws', mm') <- redoLayout m r s ws
+    runLayout (Workspace i (ModifiedLayout m l) ms) r =
+        do (ws, ml')  <- modifyLayout m (Workspace i l ms) r
+           (ws', mm') <- case ms of
+                           Just s  -> redoLayout m r s ws
+                           Nothing -> emptyLayoutMod m r ws
            let ml'' = case mm' of
-                      Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
-                      Nothing -> ModifiedLayout m `fmap` ml'
+                        Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
+                        Nothing -> ModifiedLayout m `fmap` ml'
            return (ws', ml'')
+
     handleMessage (ModifiedLayout m l) mess =
         do mm' <- handleMessOrMaybeModifyIt m mess
            ml' <- case mm' of
@@ -67,8 +272,14 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
            return $ case mm' of
                     Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
                     _ -> (ModifiedLayout m) `fmap` ml'
-    description (ModifiedLayout m l) = modifierDescription m <> description l
-     where "" <> x = x
-           x <> y = x ++ " " ++ y
+    description (ModifiedLayout m l) = modifyDescription m l
 
+-- | A 'ModifiedLayout' is simply a container for a layout modifier
+--   combined with an underlying layout.  It is, of course, itself a
+--   layout (i.e. an instance of 'LayoutClass').
 data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )
+
+-- N.B. I think there is a Haddock bug here; the Haddock output for
+-- the above does not parenthesize (m a) and (l a), which is obviously
+-- incorrect.
+

XMonad/Layout/LayoutScreens.hs

@@ -6,7 +6,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -30,14 +30,16 @@ import qualified XMonad.StackSet as W
 -- screen and long for greater flexibility (e.g. being able to see your
 -- email window at all times, a crude mimic of sticky windows).
 --
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Layout.LayoutScreens
+-- > import XMonad.Layout.TwoPane
 --
 -- Then add some keybindings; for example:
 --
--- >   , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
+-- >   , ((modMask x .|. shiftMask,                 xK_space), layoutScreens 2 (TwoPane 0.5 0.5))
+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)
 --
 -- Another example use would be to handle a scenario where xrandr didn't
 -- work properly (e.g. a VNC X server in my case) and you want to be able
@@ -45,9 +47,9 @@ import qualified XMonad.StackSet as W
 --
 -- > import XMonad.Layout.LayoutScreens
 --
--- >   , ((modMask .|. shiftMask, xK_space),
+-- >   , ((modMask x .|. shiftMask, xK_space),
 -- >        layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -56,13 +58,12 @@ layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
 layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
 layoutScreens nscr l =
     do rtrect <- asks theRoot >>= getWindowRectangle
-       (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] }
+       (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect
        windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
            let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs
-               gaps = map (statusGap . W.screenDetail) $ v:vs
-               (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps))
-           in  ws { W.current = W.Screen x 0 (SD s g)
-                  , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg
+               s:ss = map snd wss
+           in  ws { W.current = W.Screen x 0 (SD s)
+                  , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss
                   , W.hidden  = ys }
 
 getWindowRectangle :: Window -> X Rectangle

XMonad/Layout/MagicFocus.hs

@@ -13,43 +13,42 @@
 -- Automagically put the focused window in the master area.
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.MagicFocus 
+module XMonad.Layout.MagicFocus
     (-- * Usage
      -- $usage
-     MagicFocus(MagicFocus)
+     magicFocus
     ) where
 
 import XMonad
 import XMonad.StackSet
+import XMonad.Layout.LayoutModifier
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Layout.MagicFocus
 --
--- Then edit your @layoutHook@ by adding the MagicFocus layout
+-- Then edit your @layoutHook@ by adding the magicFocus layout
 -- modifier:
 --
--- > myLayouts = MagicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
+-- > myLayouts = magicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read )
+-- | Create a new layout which automagically puts the focused window
+--   in the master area.
+magicFocus :: l a -> ModifiedLayout MagicFocus l a
+magicFocus = ModifiedLayout MagicFocus
 
-instance (LayoutClass l Window) => LayoutClass (MagicFocus l) Window where
-          doLayout = magicFocus
+data MagicFocus a = MagicFocus deriving (Show, Read)
 
-magicFocus :: LayoutClass l Window => MagicFocus l Window -> Rectangle
-           -> Stack Window -> X ([(Window, Rectangle)], Maybe (MagicFocus l Window))
-magicFocus (MagicFocus l) r s = 
-    withWindowSet $ \wset -> do
-      (ws,nl) <- doLayout l r (swap s $ peek wset)
-      case nl of
-        Nothing -> return (ws, Nothing)
-        Just l' -> return (ws, Just $ MagicFocus l')
+instance LayoutModifier MagicFocus Window where
+  modifyLayout MagicFocus (Workspace i l s) r =
+    withWindowSet $ \wset ->
+      runLayout (Workspace i l (s >>= \st -> Just $ swap st (peek wset))) r
 
 swap :: (Eq a) => Stack a -> Maybe a -> Stack a
 swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d)

XMonad/Layout/Magnifier.hs

@@ -22,6 +22,10 @@ module XMonad.Layout.Magnifier
       -- $usage
       magnifier,
       magnifier',
+      magnifierOff,
+      magnifiercz,
+      magnifiercz',
+      maximizeVertical,
       MagnifyMsg (..)
     ) where
 
@@ -34,12 +38,20 @@ import XMonad.Layout.LayoutModifier
 --
 -- > import XMonad.Layout.Magnifier
 --
--- Then edit your @layoutHook@ by adding the Magnifier layout modifier
+-- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier
 -- to some layout:
 --
 -- > myLayouts = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
+-- By default magnifier increases the focused window's size by 1.5.
+-- You can also use:
+--
+-- > magnifiercz 1.2
+--
+-- to use a custom level of magnification.  You can even make the focused
+-- window smaller for a pop in effect.
+--
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
@@ -51,25 +63,52 @@ import XMonad.Layout.LayoutModifier
 -- >    , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)
 -- >    , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )
 -- >    , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )
+-- >    , ((modMask x .|. controlMask              , xK_m    ), sendMessage Toggle     )
+--
+-- Note that a few other extension modules, such as
+-- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also
+-- define a message named 'Toggle'.  To avoid conflicts when using
+-- these modules together, you can import Magnifier qualified, like
+-- this:
+--
+-- > import qualified XMonad.Layout.Magnifier as Mag
+--
+-- and then prefix @Mag@ to the front of everything from this module,
+-- like @Mag.Toggle@, @Mag.magnifier@, and so on.
 --
 -- For detailed instruction on editing the key binding see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
 -- | Increase the size of the window that has focus
 magnifier :: l a -> ModifiedLayout Magnifier l a
-magnifier = ModifiedLayout (Mag 1.5 On All)
+magnifier = ModifiedLayout (Mag (1.5,1.5) On All)
+
+-- | Change the size of the window that has focus by a custom zoom
+magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
+magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All)
 
 -- | Increase the size of the window that has focus, unless if it is the
 -- master window.
 magnifier' :: l a -> ModifiedLayout Magnifier l a
-magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)
+magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster)
 
-data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable )
+-- | Magnifier that defaults to Off
+magnifierOff :: l a -> ModifiedLayout Magnifier l a
+magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All)
+
+-- | Increase the size of the window that has focus by a custom zoom,
+-- unless if it is the master window.
+magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
+magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster)
+
+-- | A magnifier that greatly magnifies just the vertical direction
+maximizeVertical :: l a -> ModifiedLayout Magnifier l a
+maximizeVertical = ModifiedLayout (Mag (1,1000) Off All)
+
+data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )
 instance Message MagnifyMsg
 
-data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show)
-
-type Zoom = Double
+data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show)
 
 data Toggle        = On  | Off      deriving  (Read, Show)
 data MagnifyMaster = All | NoMaster deriving  (Read, Show)
@@ -81,11 +120,14 @@ instance LayoutModifier Magnifier Window where
         where nothing _ _ wrs = return (wrs, Nothing)
 
     handleMess (Mag z On  t) m
-                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On  t)
-                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On  t)
-                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z + 0.1) Off t)
+                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On  t)
+                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On  t)
+                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z      ) Off t)
+                    | Just Toggle      <- fromMessage m = return . Just $ (Mag (z      ) Off t)
+                    where addto (x,y) i = (x+i,y+i)
     handleMess (Mag z Off t) m
                     | Just ToggleOn    <- fromMessage m = return . Just $ (Mag z         On  t)
+                    | Just Toggle      <- fromMessage m = return . Just $ (Mag z         On  t)
     handleMess _ _ = return Nothing
 
     modifierDescription (Mag _ On  All     ) = "Magnifier"
@@ -98,22 +140,26 @@ unlessMaster :: NewLayout a -> NewLayout a
 unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
                                               else mainmod r s wrs
 
-applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a)
+applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]
+               -> X ([(Window, Rectangle)], Maybe a)
 applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)
-                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify z wr)]
+                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)]
                                                 | otherwise         = (w,wr) : ws
                               return (reverse $ foldr mag [] wrs, Nothing)
 
-magnify :: Double -> Rectangle -> Rectangle
-magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h'
+magnify :: (Double, Double) -> Rectangle -> Rectangle
+magnify (zoomx,zoomy) (Rectangle x y w h) = Rectangle x' y' w' h'
     where x' = x - fromIntegral (w' - w) `div` 2
           y' = y - fromIntegral (h' - h) `div` 2
-          w' = round $ fromIntegral w * zoom
-          h' = round $ fromIntegral h * zoom
+          w' = round $ fromIntegral w * zoomx
+          h' = round $ fromIntegral h * zoomy
 
-shrink :: Rectangle -> Rectangle -> Rectangle
-shrink (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'
-    where x' = max sx x
-          y' = max sy y
-          w' = min w (fromIntegral sx + sw - fromIntegral x')
-          h' = min h (fromIntegral sy + sh - fromIntegral y')
+fit :: Rectangle -> Rectangle -> Rectangle
+fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'
+    where x' = max sx (x - (max 0 (x + fi w - sx - fi sw)))
+          y' = max sy (y - (max 0 (y + fi h - sy - fi sh)))
+          w' = min sw w
+          h' = min sh h
+
+fi :: (Num b, Integral a) => a -> b
+fi = fromIntegral

XMonad/Layout/Master.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
+{-# LANGUAGE PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Master
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout that adds a distinguished master window to a base layout.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Master (
+    -- * Usage
+    -- $usage
+    mastered,
+    Master
+) where
+
+import XMonad
+import XMonad.StackSet
+
+import Data.List
+import Data.Ord
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Master
+--
+-- and add something like
+--
+-- > mastered (1/100) (1/2) $ Grid
+--
+-- to your layouts. This will use the left half of your screen for a master
+-- window and let Grid manage the right half.
+--
+-- For more detailed instructions on editing the layoutHook see
+-- "XMonad.Doc.Extending#Editing_the_layout_hook".
+--
+-- Like 'XMonad.Layout.Tall', 'Master' supports the 'XMonad.Layout.Shrink' and
+-- 'XMonad.Layout.Expand' messages.
+
+mastered :: (LayoutClass l a)
+    => Rational -- ^ @delta@, the ratio of the screen to resize by
+    -> Rational -- ^ @frac@, what portion of the screen to reserve for the master window
+    -> l a      -- ^ the layout to use for the remaining windows
+    -> Master l a
+mastered d f b = Master d f' b
+    where
+    f' = min 1 . max 0 $ f
+
+data Master l a =
+    Master{
+        delta :: Rational,
+        frac :: Rational,
+        base :: l a
+    } deriving (Show, Read, Eq, Ord)
+
+extractMaster :: Stack a -> (a, Maybe (Stack a))
+extractMaster (Stack x ls rs) = case reverse ls of
+    [] -> (x, differentiate rs)
+    (m : ls') -> (m, Just $ Stack x (reverse ls') rs)
+
+area :: Rectangle -> Dimension
+area r = rect_width r * rect_height r
+
+chop :: D -> Rectangle -> Rectangle
+chop (w, h) (Rectangle rx ry rw rh) =
+    let
+        r' = maximumBy (comparing area)
+            [ Rectangle rx (ry + fromIntegral h) rw (rh - h)
+            , Rectangle (rx + fromIntegral w) ry (rw - w) rh]
+    in
+    r'{ rect_width = max 0 $ rect_width r', rect_height = max 0 $ rect_height r' }
+
+instance (LayoutClass l Window) => LayoutClass (Master l) Window where
+    description m = "Master " ++ description (base m)
+    handleMessage m msg
+        | Just Shrink <- fromMessage msg =
+            return . Just $ m{ frac = max 0 $ frac m - delta m }
+        | Just Expand <- fromMessage msg =
+            return . Just $ m{ frac = min 1 $ frac m + delta m }
+        | otherwise =
+            fmap (fmap (\x -> m{ base = x })) $ handleMessage (base m) msg
+    runLayout ws rect = do
+        (f, ws', rect') <- case fmap extractMaster $ stack ws of
+            Nothing ->
+                return (id, ws, rect)
+            Just (x, Nothing) -> do
+                f <- mkAdjust x
+                let
+                    (w', h') = f (rect_width rect, rect_height rect)
+                    xr = rect{ rect_width = w', rect_height = h' }
+                return (((x, xr) :), ws{ stack = Nothing }, Rectangle (rect_x xr + fromIntegral w') (rect_y xr) 0 0)
+            Just (x, Just st) -> do
+                f <- mkAdjust x
+                let
+                    d@(w', h') = f (scale $ rect_width rect, rect_height rect)
+                    xr = rect{ rect_width = w', rect_height = h' }
+                return (((x, xr) :), ws{ stack = Just st }, chop d rect)
+        (y, l) <- runLayout ws'{ layout = base m } rect'
+        return (f y, fmap (\x -> m{ base = x }) l)
+        where
+        m = layout ws
+        scale = round . (* frac m) . fromIntegral

XMonad/Layout/Mosaic.hs

@@ -1,485 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Mosaic
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- This module defines a \"mosaic\" layout, which tries to give each window a
--- user-configurable relative area, while also trying to give them aspect
--- ratios configurable at run-time by the user.
---
------------------------------------------------------------------------------
-module XMonad.Layout.Mosaic (
-                             -- * Usage
-                             -- $usage
-                             mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,
-                             tallWindow, wideWindow, flexibleWindow,
-                             getName ) where
-
-import Control.Monad.State ( State, put, get, runState )
-import System.Random ( StdGen, mkStdGen )
-import Data.Maybe ( isJust )
-
-import XMonad hiding ( trace )
-import qualified XMonad.StackSet as W
-import qualified Data.Map as M
-import Data.List ( sort )
-import Data.Typeable ( Typeable )
-import Control.Monad ( mplus )
-
-import XMonad.Util.NamedWindows
-import XMonad.Util.Anneal
-
--- $usage
--- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
---
--- > import XMonad.Layout.Mosaic
---
--- Then edit your @layoutHook@ by adding the Mosaic layout:
---
--- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc..
--- > main = xmonad defaultConfig { layoutHook = myLayouts }
---
--- For more detailed instructions on editing the layoutHook see:
---
--- "XMonad.Doc.Extending#Editing_the_layout_hook"
---
--- In the key-bindings, do something like:
---
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
--- >   , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
--- >   , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
--- >   , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
--- >   , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
--- >   , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
---
--- For detailed instruction on editing the key binding see:
---
--- "XMonad.Doc.Extending#Editing_key_bindings".
-
-data HandleWindow = ExpandWindow Window | ShrinkWindow Window
-                  | SquareWindow Window | ClearWindow Window
-                  | TallWindow Window | WideWindow Window
-                  | FlexibleWindow Window
-                    deriving ( Typeable, Eq )
-
-instance Message HandleWindow
-
-expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow
-expandWindow   = ExpandWindow
-shrinkWindow   = ShrinkWindow
-squareWindow   = SquareWindow
-flexibleWindow = FlexibleWindow
-myclearWindow  = ClearWindow
-tallWindow     = TallWindow
-wideWindow     = WideWindow
-
-largeNumber :: Int
-largeNumber = 50
-
-defaultArea :: Double
-defaultArea = 1
-
-flexibility :: Double
-flexibility = 0.1
-
-mosaic :: Double -> Double -> MosaicLayout Window
-mosaic d t = Mosaic d t M.empty
-
-data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint])
-              deriving ( Show, Read )
-
-instance LayoutClass MosaicLayout Window where
-    doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h
-                                      mosaicL t all_hints r (W.integrate st)
-        where add_hints [] x = return x
-              add_hints (w:ws) x =
-                  do z <- withDisplay $ \d -> io $ getWMNormalHints d w
-                     let set_asp = case map4 `fmap` sh_aspect z of
-                                   Just ((minx,miny),(maxx,maxy))
-                                       | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id
-                                       | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w
-                                   _ -> id
-                     add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x
-              map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double))
-              map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d))
-
-    pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m)
-        where
-          m1 Shrink             = Mosaic d (t/(1+d)) h
-          m1 Expand             = Mosaic d (t*(1+d)) h
-          m2 (ExpandWindow w)   = Mosaic d t (multiply_area (1+d) w h)
-          m2 (ShrinkWindow w)   = Mosaic d t (multiply_area (1/(1+ d)) w h)
-          m2 (SquareWindow w)   = Mosaic d t (set_aspect_ratio 1 w h)
-          m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h)
-          m2 (TallWindow w)     = Mosaic d t (multiply_aspect (1/(1+d)) w h)
-          m2 (WideWindow w)     = Mosaic d t (multiply_aspect (1+d) w h)
-          m2 (ClearWindow w)    = Mosaic d t (M.delete w h)
-
-    description _ = "mosaic"
-
-multiply_area :: Double -> Window
-              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)]
-                                    f (RelArea a':xs) = RelArea (a'*a) : xs
-                                    f (x:xs) = x : f xs
-
-set_aspect_ratio :: Double -> Window
-                 -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-set_aspect_ratio r = alterlist f where f [] = [AspectRatio r]
-                                       f (FlexibleAspectRatio _:x) = AspectRatio r:x
-                                       f (AspectRatio _:x) = AspectRatio r:x
-                                       f (x:xs) = x:f xs
-
-make_flexible :: Window
-              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r
-                                        f (FlexibleAspectRatio r) = AspectRatio r
-                                        f x = x
-
-multiply_aspect :: Double -> Window
-                -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r]
-                                      f (AspectRatio r':x) = AspectRatio (r*r'):x
-                                      f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x
-                                      f (x:xs) = x:f xs
-
-set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx)
-           | otherwise = const id
-
-set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx)
-           | otherwise = const id
-
-isMaxX,isMaxY :: WindowHint -> Maybe Dimension
-isMaxX (MaxX x) = Just x
-isMaxX _ = Nothing
-isMaxY (MaxY x) = Just x
-isMaxY _ = Nothing
-
-set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx)
-           | otherwise = const id
-    where isMinX (MinX _) = True
-          isMinX _ = False
-
-set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
-set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx)
-           | otherwise = const id
-    where isMinY (MinY _) = True
-          isMinY _ = False
-
-replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a]
-replaceinmap repl v = alterlist f where f [] = [v]
-                                        f (x:xs) | repl x = v:xs
-                                                 | otherwise = x:f xs
-
-findlist :: Window -> M.Map Window [a] -> [a]
-findlist = M.findWithDefault []
-
-alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a]
-alterlist f k = M.alter f' k
-    where f' Nothing = f' (Just [])
-          f' (Just xs) = case f xs of
-                           [] -> Nothing
-                           xs' -> Just xs'
-
-mosaicL :: Double -> M.Map Window [WindowHint]
-        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window))
-mosaicL _ _ _ [] = return ([], Nothing)
-mosaicL f hints origRect origws
-    = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws
-             -- TODO: remove all this dead code
-             myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws
-             myv2 = mc_mosaic sortedws Vertical
-             myh2 = mc_mosaic sortedws Horizontal
---             myv2 = maxL $ runCountDown largeNumber $
---                    sequence $ replicate mediumNumber $
---                    mosaic_splits one_split origRect Vertical sortedws
-             myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws
---             myh2 = maxL $ runCountDown largeNumber $
---                    sequence $ replicate mediumNumber $
---                    mosaic_splits one_split origRect Horizontal sortedws
-         return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw,
-                                 --                           show $ rate f meanarea (findlist nw hints) r,
-                                 --                           show r,
-                                 --                           show $ area r/meanarea,
-                                 --                           show $ findlist nw hints]) $
-                                 w,crop' (findlist w hints) r)) $
-                flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)
-    where mosaic_splits _ _ _ [] = return $ Rated 0 $ M []
-          mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r)
-          mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws)
-          even_split :: Rectangle -> CutDirection -> [[Window]]
-                     -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))
-          even_split r d [ws] = even_split r d $ map (:[]) ws
-          even_split r d wss =
-              do let areas = map sumareas wss
-                     maxds = map (maxd d) wss
-                 let wsr_s :: [([Window], Rectangle)]
-                     wsr_s = zip wss (partitionR d r maxds areas)
-                 submosaics <- mapM (\(ws',r') ->
-                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s
-                 return $ fmap M $ catRated submosaics
-          {-
-          another_mosaic :: [Window] -> CutDirection
-                         -> Rated Double (Mosaic (Window,Rectangle))
-          another_mosaic ws d = rate_mosaic ratew $
-                                rect_mosaic origRect d $
-                                zipML (example_mosaic ws) (map findarea ws)
-          -}
-          mc_mosaic :: [Window] -> CutDirection
-                    -> Rated Double (Mosaic (Window,Rectangle))
-          mc_mosaic ws d = fmap (rect_mosaic origRect d) $
-                           annealMax (zipML (example_mosaic ws) (map findarea ws))
-                           (the_rating . rate_mosaic ratew . rect_mosaic origRect d )
-                           changeMosaic
-
-          ratew :: (Window,Rectangle) -> Double
-          ratew (w,r) = rate f meanarea (findlist w hints) r
-          example_mosaic :: [Window] -> Mosaic Window
-          example_mosaic ws = M (map OM ws)
-          rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle)
-          rect_mosaic r _ (OM (w,_)) = OM (w,r)
-          rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs
-              where areas = map (sum . map snd . flattenMosaic) ws
-                    maxds = repeat 1
-                    rs = partitionR d r maxds areas
-                    d' = otherDirection d
-          rate_mosaic :: ((Window,Rectangle) -> Double)
-                      -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle))
-          rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m
-{-
-          one_split :: Rectangle -> CutDirection -> [[Window]]
-                    -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))
-          one_split r d [ws] = one_split r d $ map (:[]) ws
-          one_split r d wss =
-              do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss]
-                 let wsr_s :: [([Window], Rectangle)]
-                     wsr_s = zip wss (partitionR d r rnd)
-                 submosaics <- mapM (\(ws',r') ->
-                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s
-                 return $ fmap M $ catRated submosaics
--}
-          partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle]
-          partitionR _ _ _ [] = []
-          partitionR _ _ [] _ = []
-          partitionR _ r _ [_] = [r]
-          partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars
-              where totarea = sum (a:ars)
-                    totd = fromIntegral $ dimR d r
-                    (r1,r2) = if a/totarea > fromIntegral m / totd
-                              then if a/totarea > 1 - fromIntegral (sum ms) / totd
-                                   then split d (1 - fromIntegral (sum ms) / totd) r
-                                   else split d (a/totarea) r
-                              else split d (fromIntegral m / totd) r
-          theareas = hints2area `fmap` hints
-          sumareas ws = sum $ map findarea ws
-          maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws
-          maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws
-          findarea :: Window -> Double
-          findarea w = M.findWithDefault 1 w theareas
-          findhinted fh d w = fh' $ M.findWithDefault [] w hints
-              where fh' [] = d
-                    fh' (h:hs) | Just x <- fh h = x
-                               | otherwise = fh' hs
-          meanarea =  area origRect / fromIntegral (length origws)
-
-dimR :: CutDirection -> Rectangle -> Dimension
-dimR Vertical (Rectangle _ _ _ h) = h
-dimR Horizontal (Rectangle _ _ w _) = w
-
-maxL :: Ord a => [a] -> a
-maxL [] = error "maxL on empty list"
-maxL [a] = a
-maxL (a:b:c) = maxL (max a b:c)
-
-catRated :: Floating v => [Rated v a] -> Rated v [a]
-catRated xs = Rated (product $ map the_rating xs) (map the_value xs)
-
-catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a)
-catRatedM (OM (Rated v x)) =  Rated v (OM x)
-catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs')
-
-data CountDown = CD !StdGen !Int
-
-tries_left :: State CountDown Int
-tries_left = do CD _ n <- get
-                return (max 0 n)
-
-mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b]
-mapCD f xs = do n <- tries_left
-                let len = length xs
-                mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs
-
-run_with_only :: Int -> State CountDown a -> State CountDown a
-run_with_only limit j =
-    do CD g n <- get
-       let leftover = n - limit
-       if leftover < 0 then j
-                       else do put $ CD g limit
-                               x <- j
-                               CD g' n' <- get
-                               put $ CD g' (leftover + n')
-                               return x
-
-data WindowHint = RelArea Double
-                | MaxX Dimension
-                | MaxY Dimension
-                | MinX Dimension
-                | MinY Dimension
-                | AspectRatio Double
-                | FlexibleAspectRatio Double
-                  deriving ( Show, Read, Eq, Ord )
-
-fixedAspect :: [WindowHint] -> Bool
-fixedAspect [] = False
-fixedAspect (AspectRatio _:_) = True
-fixedAspect (_:x) = fixedAspect x
-
-rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double
-rate defaulta meanarea xs rr
-    | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight
-    | otherwise = (area rr / meanarea)**(weight-flexibility)
-                  * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility
-     where weight = hints2area xs
-
-crop1 :: WindowHint -> Rectangle -> Rectangle
-crop1 (FlexibleAspectRatio f) r = cropit f r
-crop1 h r = crop1' h r
-
-crop1' :: WindowHint -> Rectangle -> Rectangle
-crop1' (AspectRatio f) r = cropit f r
-crop1' (FlexibleAspectRatio f) r = cropit f r
-crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h
-                                     | otherwise = Rectangle x y w h
-crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm
-                                     | otherwise = Rectangle x y w h
-crop1' _ r = r
-
-crop :: [WindowHint] -> Rectangle -> Rectangle
-crop (h:hs) = crop hs . crop1 h
-crop [] = id
-
-crop' :: [WindowHint] -> Rectangle -> Rectangle
-crop' (h:hs) = crop' hs . crop1' h
-crop' [] = id
-
-cropit :: Double -> Rectangle -> Rectangle
-cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h
-                             | otherwise = Rectangle a b w (ceiling $ w -/ f)
-
-hints2area :: [WindowHint] -> Double
-hints2area [] = defaultArea
-hints2area (RelArea r:_) = r
-hints2area (_:x) = hints2area x
-
-area :: Rectangle -> Double
-area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h
-
-(-/-) :: (Integral a, Integral b) => a -> b -> Double
-a -/- b = fromIntegral a / fromIntegral b
-
-(-/) :: (Integral a) => a -> Double -> Double
-a -/ b = fromIntegral a / b
-
-(-*) :: (Integral a) => a -> Double -> Double
-a -* b = fromIntegral a * b
-
-split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle)
-split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r
-split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h,
-                                               Rectangle sx (sy+fromIntegral h) sw (sh-h))
-    where h = floor $ fromIntegral sh * frac
-split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh,
-                                                 Rectangle (sx+fromIntegral w) sy (sw-w) sh)
-    where w = floor $ fromIntegral sw * frac
-
-data CutDirection = Vertical | Horizontal
-otherDirection :: CutDirection -> CutDirection
-otherDirection Vertical = Horizontal
-otherDirection Horizontal = Vertical
-
-data Mosaic a = M [Mosaic a] | OM a
-          deriving ( Show )
-
-instance Functor Mosaic where
-    fmap f (OM x) = OM (f x)
-    fmap f (M xs) = M (map (fmap f) xs)
-
-zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c
-zipMLwith f (OM x) (y:_) = OM (f x y)
-zipMLwith _ (OM _) [] = error "bad zipMLwith"
-zipMLwith f (M xxs) yys = makeM $ foo xxs yys
-    where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) :
-                          foo xs (drop (lengthM x) ys)
-          foo [] _ = []
-
-zipML :: Mosaic a -> [b] -> Mosaic (a,b)
-zipML = zipMLwith (\a b -> (a,b))
-
-lengthM :: Mosaic a -> Int
-lengthM (OM _) = 1
-lengthM (M x) = sum $ map lengthM x
-
-changeMosaic :: Mosaic a -> [Mosaic a]
-changeMosaic (OM _) = []
-changeMosaic (M xs) = map makeM (concatenations xs) ++
-                      map makeM (splits xs) ++
-                      map M (tryAll changeMosaic xs)
-
-tryAll :: (a -> [a]) -> [a] -> [[a]]
-tryAll _ [] = []
-tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs)
-
-splits :: [Mosaic a] -> [[Mosaic a]]
-splits [] = []
-splits (OM x:y) = map (OM x:) $ splits y
-splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z)
-splits (M []:x) = splits x
-
-concatenations :: [Mosaic a] -> [[Mosaic a]]
-concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z))
-concatenations _ = []
-
-concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a
-concatenateMosaic (OM a) (OM b) = M [OM a, OM b]
-concatenateMosaic (OM a) (M b) = M (OM a:b)
-concatenateMosaic (M a) (OM b) = M (a++[OM b])
-concatenateMosaic (M a) (M b) = M (a++b)
-
-makeM :: [Mosaic a] -> Mosaic a
-makeM [m] = m
-makeM [] = error "makeM []"
-makeM ms = M ms
-
-flattenMosaic :: Mosaic a -> [a]
-flattenMosaic (OM a) = [a]
-flattenMosaic (M xs) = concatMap flattenMosaic xs
-
-allsplits :: [a] -> [[[a]]]
-allsplits [] = [[[]]]
-allsplits [a] = [[[a]]]
-allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest)
-    where splitsrest = allsplits' xs
-
-allsplits' :: [a] -> [[[a]]]
-allsplits' [] = [[[]]]
-allsplits' [a] = [[[a]]]
-allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest)
-    where splitsrest = allsplits xs
-
-maphead :: (a->a) -> [a] -> [a]
-maphead f (x:xs) = f x : xs
-maphead _ [] = []
-
-runCountDown :: Int -> State CountDown a -> a
-runCountDown n x = fst $ runState x (CD (mkStdGen n) n)

XMonad/Layout/MultiToggle.hs

@@ -15,7 +15,6 @@
 -- currently focused window occupy the whole screen (\"zoom in\") then undo
 -- the transformation (\"zoom out\").
 
-
 module XMonad.Layout.MultiToggle (
     -- * Usage
     -- $usage
@@ -23,11 +22,15 @@ module XMonad.Layout.MultiToggle (
     Toggle(..),
     (??),
     EOT(..),
-    mkToggle
+    single,
+    mkToggle,
+    mkToggle1
 ) where
 
 import XMonad
 
+import XMonad.StackSet (Workspace(..))
+
 import Control.Arrow
 import Data.Typeable
 import Data.Maybe
@@ -39,22 +42,14 @@ import Data.Maybe
 -- group of radio buttons.
 --
 -- A side effect of this meta-layout is that layout transformers no longer
--- receive any messages; any message not handled by SwitchTrans itself will
+-- receive any messages; any message not handled by MultiToggle itself will
 -- undo the current layout transformer, pass the message on to the base
 -- layout, then reapply the transformer.
 --
--- To use this module, you first have to define the transformers that you
--- want to be handled by @MultiToggle@. For example, if the transformer is
--- 'XMonad.Layout.Mirror':
---
--- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)
--- > instance Transformer MIRROR Window where
--- >     transform _ x k = k (Mirror x)
---
--- @MIRROR@ can be any identifier (it has to start with an uppercase letter,
--- of course); I've chosen an all-uppercase version of the transforming
--- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@
--- at the beginning of your file to be able to derive "Data.Typeable".
+-- To use this module, you need some data types which represent
+-- transformers; for some commonly used transformers (including
+-- MIRROR, NOBORDERS, and FULL used in the examples below) you can
+-- simply import "XMonad.Layout.MultiToggle.Instances".
 --
 -- Somewhere else in your file you probably have a definition of @layout@;
 -- the default looks like this:
@@ -63,7 +58,7 @@ import Data.Maybe
 --
 -- After changing this to
 --
--- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full)
+-- > layout = mkToggle (single MIRROR) (tiled ||| Full)
 --
 -- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation:
 --
@@ -74,29 +69,33 @@ import Data.Maybe
 -- (That should be part of your key bindings.) When you press @mod-x@, the
 -- active layout is mirrored. Another @mod-x@ and it's back to normal.
 --
--- It's also possible to stack @MultiToggle@s. Let's define a few more
--- transformers ('XMonad.Layout.NoBorders.noBorders' is in
--- "XMonad.Layout.NoBorders"):
---
--- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable)
--- > instance Transformer NOBORDERS Window where
--- >     transform _ x k = k (noBorders x)
--- > 
--- > data FULL = FULL deriving (Read, Show, Eq, Typeable)
--- > instance Transformer FULL Window where
--- >     transform _ x k = k Full
+-- It's also possible to stack @MultiToggle@s.  For example:
 --
 -- @
 -- layout = id
 --     . 'XMonad.Layout.NoBorders.smartBorders'
 --     . mkToggle (NOBORDERS ?? FULL ?? EOT)
---     . mkToggle (MIRROR ?? EOT)
+--     . mkToggle (single MIRROR)
 --     $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle'
 -- @
 --
 -- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily
 -- maximize windows, in addition to being able to rotate layouts and remove
 -- window borders.
+--
+-- You can also define your own transformers by creating a data type
+-- which is an instance of the 'Transformer' class.  For example, here
+-- is the definition of @MIRROR@:
+--
+-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)
+-- > instance Transformer MIRROR Window where
+-- >     transform _ x k = k (Mirror x)
+--
+-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the
+-- beginning of your file (ghc 6.8 only; with ghc 6.6 you can use
+-- @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ instead) to be able to
+-- derive "Data.Typeable".
+--
 
 -- | A class to identify custom transformers (and look up transforming
 -- functions by type).
@@ -154,6 +153,11 @@ instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where
 mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a
 mkToggle ts l = MultiToggle l (EL l) Nothing id ts
 
+-- | Construct a @MultiToggle@ layout from a single transformer and a base
+-- layout.
+mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a
+mkToggle1 t = mkToggle (single t)
+
 -- | Marks the end of a transformer list.
 data EOT = EOT deriving (Read, Show)
 data HCons a b = HCons a b deriving (Read, Show)
@@ -164,6 +168,10 @@ infixr 0 ??
 (??) :: (HList b w) => a -> b -> HCons a b
 (??) = HCons
 
+-- | Construct a singleton transformer table.
+single :: a -> HCons a EOT
+single = (?? EOT)
+
 class HList c a where
     find :: (Transformer t a) => c -> t -> Maybe Int
     resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b
@@ -189,11 +197,13 @@ acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggl
 acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x }))
 
 instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where
-    description _ = "MultiToggle"
+    description mt = currLayout mt `unEL` \l -> description l
 
-    pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s
-
-    doLayout mt r s = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (doLayout l r s)
+    runLayout (Workspace i mt s) r
+        | isNothing (currIndex mt) =
+            acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r
+        | otherwise = currLayout mt `unEL` \l ->
+            acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r
 
     handleMessage mt m
         | Just (Toggle t) <- fromMessage m

XMonad/Layout/MultiToggle/Instances.hs

@@ -0,0 +1,40 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+-- above is for compatibility with GHC 6.6.
+{- LANGUAGE TypeSynonymInstances, DeriveDataTypeable -}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.MultiToggle.Instances
+-- Copyright   :  (c) 2008  Brent Yorgey
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Some convenient common instances of the
+-- 'XMonad.Layout.MultiToggle.Transformer' class, for use with
+-- "XMonad.Layout.MultiToggle".
+
+module XMonad.Layout.MultiToggle.Instances (
+  StdTransformers(..)
+) where
+
+import XMonad.Layout.MultiToggle
+
+import XMonad
+import XMonad.Layout.NoBorders
+
+data StdTransformers = FULL          -- ^ switch to Full layout
+                     | NBFULL        -- ^ switch to Full with no borders
+                     | MIRROR        -- ^ Mirror the current layout.
+                     | NOBORDERS     -- ^ Remove borders.
+                     | SMARTBORDERS  -- ^ Apply smart borders.
+  deriving (Read, Show, Eq, Typeable)
+
+instance Transformer StdTransformers Window where
+    transform FULL         _ k = k Full
+    transform NBFULL       _ k = k (noBorders Full)
+    transform MIRROR       x k = k (Mirror x)
+    transform NOBORDERS    x k = k (noBorders x)
+    transform SMARTBORDERS x k = k (smartBorders x)

XMonad/Layout/Named.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -6,7 +6,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -14,13 +14,13 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.Named (
-                                -- * Usage
-                                -- $usage
-                                Named(Named)
-                               ) where
+module XMonad.Layout.Named
+    ( -- * Usage
+      -- $usage
+      named
+    ) where
 
-import XMonad
+import XMonad.Layout.LayoutModifier
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -30,18 +30,17 @@ import XMonad
 -- Then edit your @layoutHook@ by adding the Named layout modifier
 -- to some layout:
 --
--- > myLayouts = Named "real big" Full ||| etc..
+-- > myLayouts = named "real big" Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-data Named l a = Named String (l a) deriving ( Read, Show )
+named :: String -> l a -> ModifiedLayout Named l a
+named s = ModifiedLayout (Named s)
 
-instance (LayoutClass l a) => LayoutClass (Named l) a where
-    doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s
-                                  return (ws, Named n `fmap` ml')
-    handleMessage (Named n l) mess = do ml' <- handleMessage l mess
-                                        return $ Named n `fmap` ml'
-    description (Named n _) = n
+data Named a = Named String deriving ( Read, Show )
+
+instance LayoutModifier Named a where
+    modifyDescription (Named n) _ = n

XMonad/Layout/NoBorders.hs

@@ -6,7 +6,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -29,6 +29,7 @@ import XMonad
 import XMonad.Layout.LayoutModifier
 import qualified XMonad.StackSet as W
 import Data.List ((\\))
+import qualified Data.Map as M
 
 -- $usage
 -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
@@ -57,9 +58,12 @@ instance LayoutModifier WithBorder Window where
      where
         ws = map fst wrs
 
+-- | Removes all window borders from the specified layout.
 noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window
-noBorders = ModifiedLayout $ WithBorder 0 []
+noBorders = withBorder 0
 
+-- | Forces a layout to use the specified border width. 'noBorders' is
+-- equivalent to @'withBorder' 0@.
 withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a
 withBorder b = ModifiedLayout $ WithBorder b []
 
@@ -71,26 +75,34 @@ data SmartBorder a = SmartBorder [a] deriving (Read, Show)
 instance LayoutModifier SmartBorder Window where
     unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
 
-    redoLayout (SmartBorder s) _ _ wrs = do
-        ss <- gets (W.screens . windowset)
-
-        if singleton ws && singleton ss
-            then do
-                asks (borderWidth . config) >>= setBorders (s \\ ws)
-                setBorders ws 0
-                return (wrs, Just $ SmartBorder ws)
-            else do
-                asks (borderWidth . config) >>= setBorders s
-                return (wrs, Just $ SmartBorder [])
+    redoLayout (SmartBorder s) _ st wrs = do
+        wset <- gets windowset
+        let managedwindows = W.integrate st
+            screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset
+            ws = tiled ++ floating
+            tiled = case filter (`elem` managedwindows) $ map fst wrs of
+                [w] | singleton screens -> [w]
+                _ -> []
+            floating =
+                [ w |
+                    (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
+                    px <= 0, py <= 0,
+                    wx + px >= 1, wy + py >= 1
+                ]
+        asks (borderWidth . config) >>= setBorders (s \\ ws)
+        setBorders ws 0
+        return (wrs, Just $ SmartBorder ws)
      where
-        ws = map fst wrs
         singleton = null . drop 1
+        nonzerorect (Rectangle _ _ 0 0) = False
+        nonzerorect _ = True
 
+-- | Removes the borders from a window under one of the following conditions:
 --
--- | You can cleverly set no borders on a range of layouts, using a
--- layoutHook like so:
+--  * There is only one screen and only one window. In this case it's obvious
+--  that it has the focus, so no border is needed.
 --
--- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ...
+--  * A floating window covers the entire screen (e.g. mplayer).
 --
 smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a
 smartBorders = ModifiedLayout (SmartBorder [])

XMonad/Layout/PerWorkspace.hs

@@ -10,20 +10,23 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Configure layouts on a per-workspace basis.  NOTE that this module
--- does not (yet) work in conjunction with multiple screens! =(
+-- Configure layouts on a per-workspace basis: use layouts and apply
+-- layout modifiers selectively, depending on the workspace.
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.PerWorkspace (
-                                    -- * Usage
-                                    -- $usage
-
-                                    onWorkspace, onWorkspaces
-                                  ) where
+module XMonad.Layout.PerWorkspace
+    ( -- * Usage
+      -- $usage
+      PerWorkspace,
+      onWorkspace, onWorkspaces,
+      modWorkspace, modWorkspaces
+    ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
+import XMonad.Layout.LayoutModifier
+
 import Data.Maybe (fromMaybe)
 
 -- $usage
@@ -33,21 +36,21 @@ import Data.Maybe (fromMaybe)
 --
 -- and modifying your layoutHook as follows (for example):
 --
--- > layoutHook = onWorkspace "foo" l1 $  -- layout l1 will be used on workspace "foo".
+-- > layoutHook = modWorkspace "baz" m1 $  -- apply layout modifier m1 to all layouts on workspace "baz"
+-- >              onWorkspace "foo" l1 $  -- layout l1 will be used on workspace "foo".
 -- >              onWorkspaces ["bar","6"] l2 $  -- layout l2 will be used on workspaces "bar" and "6".
 -- >              l3                      -- layout l3 will be used on all other workspaces.
 --
--- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts,
--- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@
+-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated
+-- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText
+-- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a
+-- function of type @(l a -> ModifiedLayout lm l a)@.
 --
 -- In another scenario, suppose you wanted to have layouts A, B, and C
 -- available on all workspaces, except that on workspace foo you want
 -- layout D instead of C.  You could do that as follows:
 --
 -- > layoutHook = A ||| B ||| onWorkspace "foo" D C
---
--- NOTE that this module does not (yet) work in conjunction with
--- multiple screens. =(
 
 -- | Specify one layout to use on a particular workspace, and another
 --   to use on all others.  The second layout can be another call to
@@ -57,7 +60,7 @@ onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
                -> (l1 a)      -- ^ layout to use on the matched workspace
                -> (l2 a)      -- ^ layout to use everywhere else
                -> PerWorkspace l1 l2 a
-onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
+onWorkspace wsId = onWorkspaces [wsId]
 
 -- | Specify one layout to use on a particular set of workspaces, and
 --   another to use on all other workspaces.
@@ -66,73 +69,59 @@ onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
                 -> (l1 a)         -- ^ layout to use on matched workspaces
                 -> (l2 a)         -- ^ layout to use everywhere else
                 -> PerWorkspace l1 l2 a
-onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2
+onWorkspaces wsIds l1 l2 = PerWorkspace wsIds False l1 l2
+
+-- | Specify a layout modifier to apply to a particular workspace; layouts
+--   on all other workspaces will remain unmodified.
+modWorkspace :: (LayoutClass l a)
+             => WorkspaceId                     -- ^ tag of the workspace to match
+             -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching workspace
+             -> l a                             -- ^ the base layout
+             -> PerWorkspace (ModifiedLayout lm l) l a
+modWorkspace wsId = modWorkspaces [wsId]
+
+-- | Specify a layout modifier to apply to a particular set of
+--   workspaces; layouts on all other workspaces will remain
+--   unmodified.
+modWorkspaces :: (LayoutClass l a)
+              => [WorkspaceId]                   -- ^ tags of the workspaces to match
+              -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching workspaces
+              -> l a                             -- ^ the base layout
+              -> PerWorkspace (ModifiedLayout lm l) l a
+modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l
 
 -- | Structure for representing a workspace-specific layout along with
---   a layout for all other workspaces.  We store the tags of workspaces
---   to be matched, and the two layouts.  Since layouts are stored\/tracked
---   per workspace, once we figure out whether we're on a matched workspace,
---   we can cache that information using a (Maybe Bool).  This is necessary
---   to be able to correctly implement the 'description' method of
---   LayoutClass, since a call to description is not able to query the
---   WM state to find out which workspace it was called in.
+-- a layout for all other workspaces. We store the tags of workspaces
+-- to be matched, and the two layouts. We save the layout choice in
+-- the Bool, to be used to implement description.
 data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]
-                                         (Maybe Bool)
+                                         Bool
                                          (l1 a)
                                          (l2 a)
     deriving (Read, Show)
 
-instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where
+instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where
+    runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r
+        | i `elem` wsIds = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r
+                              return (wrs, Just $ mkNewPerWorkspaceT p mlt')
+        | otherwise      = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r
+                              return (wrs, Just $ mkNewPerWorkspaceF p mlt')
 
-    -- do layout with l1, then return a modified PerWorkspace caching
-    --   the fact that we're in the matched workspace.
-    doLayout p@(PerWorkspace _ (Just True) lt _) r s = do
-        (wrs, mlt') <- doLayout lt r s
-        return (wrs, Just $ mkNewPerWorkspaceT p mlt')
+    handleMessage (PerWorkspace wsIds bool lt lf) m
+        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf)
+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf)
 
-    -- do layout with l1, then return a modified PerWorkspace caching
-    --   the fact that we're not in the matched workspace.
-    doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do
-        (wrs, mlf') <- doLayout lf r s
-        return (wrs, Just $ mkNewPerWorkspaceF p mlf')
-
-    -- figure out which layout to use based on the current workspace.
-    doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do
-        t <- getCurrentTag
-        doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s
-
-    -- handle messages; same drill as doLayout.
-    handleMessage p@(PerWorkspace _ (Just True) lt _) m = do
-        mlt' <- handleMessage lt m
-        return . Just $ mkNewPerWorkspaceT p mlt'
-
-    handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do
-        mlf' <- handleMessage lf m
-        return . Just $ mkNewPerWorkspaceF p mlf'
-
-    handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing
-
-    description (PerWorkspace _ (Just True ) l1 _) = description l1
-    description (PerWorkspace _ (Just False) _ l2) = description l2
-
-    -- description's result is not in the X monad, so we have to wait
-    -- until a doLayout for the information about which workspace
-    -- we're in to get cached.
-    description _ = "PerWorkspace"
+    description (PerWorkspace _ True  l1 _) = description l1
+    description (PerWorkspace _ _     _ l2) = description l2
 
 -- | Construct new PerWorkspace values with possibly modified layouts.
 mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->
                       PerWorkspace l1 l2 a
-mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' =
-    (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt'
+mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' =
+    (\lt' -> PerWorkspace wsIds True lt' lf) $ fromMaybe lt mlt'
 
 mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->
                       PerWorkspace l1 l2 a
-mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' =
-    (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf'
+mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' =
+    (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf'
 
--- | Get the tag of the currently active workspace.  Note that this
---   is only guaranteed to be the same workspace for which doLayout
---   was called if there is only one screen.
-getCurrentTag :: X WorkspaceId
-getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current

XMonad/Layout/Reflect.hs

@@ -0,0 +1,115 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+-- for now, use -fglasgow-exts for compatibility with ghc 6.6, which chokes
+-- on some of the LANGUAGE pragmas below
+{- LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances -}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Reflect
+-- Copyright   :  (c) Brent Yorgey
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Reflect a layout horizontally or vertically.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Reflect (
+                               -- * Usage
+                               -- $usage
+
+                               reflectHoriz, reflectVert,
+                               REFLECTX(..), REFLECTY(..)
+
+                             ) where
+
+import XMonad.Core
+import Graphics.X11 (Rectangle(..), Window)
+import Control.Arrow (second)
+
+import XMonad.Layout.LayoutModifier
+import XMonad.Layout.MultiToggle
+
+-- $usage
+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Layout.Reflect
+--
+-- and modifying your layoutHook as follows (for example):
+--
+-- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2)  -- put master pane on the right
+--
+-- 'reflectHoriz' and 'reflectVert' can be applied to any sort of
+-- layout (including Mirrored layouts) and will simply flip the
+-- physical layout of the windows vertically or horizontally.
+--
+-- "XMonad.Layout.MultiToggle" transformers are also provided for
+-- toggling layouts between reflected\/non-reflected with a keybinding.
+-- To use this feature, you will also need to import the MultiToggle
+-- module:
+--
+-- > import XMonad.Layout.MultiToggle
+--
+-- Next, add one or more toggles to your layout.  For example, to allow
+-- separate toggling of both vertical and horizontal reflection:
+--
+-- > layoutHook = mkToggle (single REFLECTX) $
+-- >              mkToggle (single REFLECTY) $
+-- >                (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use
+--
+-- Finally, add some keybindings to do the toggling, for example:
+--
+-- > , ((modMask x .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX)
+-- > , ((modMask x .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY)
+--
+
+-- | Apply a horizontal reflection (left \<--\> right) to a
+--   layout.
+reflectHoriz :: l a -> ModifiedLayout Reflect l a
+reflectHoriz = ModifiedLayout (Reflect Horiz)
+
+-- | Apply a vertical reflection (top \<--\> bottom) to a
+--   layout.
+reflectVert :: l a -> ModifiedLayout Reflect l a
+reflectVert = ModifiedLayout (Reflect Vert)
+
+data ReflectDir = Horiz | Vert
+  deriving (Read, Show)
+
+-- | Given an axis of reflection and the enclosing rectangle which
+--   contains all the laid out windows, transform a rectangle
+--   representing a window into its flipped counterpart.
+reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle
+reflectRect Horiz (Rectangle sx _ sw _) (Rectangle rx ry rw rh) =
+  Rectangle (2*sx + fi sw - rx - fi rw) ry rw rh
+reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) =
+  Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+
+data Reflect a = Reflect ReflectDir deriving (Show, Read)
+
+instance LayoutModifier Reflect a where
+
+    -- reflect all the generated Rectangles.
+    pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d)
+
+    modifierDescription (Reflect d) = "Reflect" ++ xy
+      where xy = case d of { Horiz -> "X" ; Vert -> "Y" }
+
+
+-------- instances for MultiToggle ------------------
+
+data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable)
+data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable)
+
+instance Transformer REFLECTX Window where
+    transform REFLECTX x k = k (reflectHoriz x)
+
+instance Transformer REFLECTY Window where
+    transform REFLECTY x k = k (reflectVert x)

XMonad/Layout/ResizableTile.hs

@@ -21,9 +21,11 @@ module XMonad.Layout.ResizableTile (
                                     ResizableTall(..), MirrorResize(..)
                                    ) where
 
-import XMonad hiding (splitVertically, splitHorizontallyBy)
+import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
 import qualified XMonad.StackSet as W
 import Control.Monad
+import qualified Data.Map as M
+import Data.List ((\\))
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -58,12 +60,16 @@ instance LayoutClass ResizableTall a where
         ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate
     handleMessage (ResizableTall nmaster delta frac mfrac) m =
         do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
-           case ms of
-             Nothing -> return Nothing
-             Just s -> return $ msum [fmap resize (fromMessage m)
-                                     ,fmap (\x -> mresize x s) (fromMessage m)
-                                     ,fmap incmastern (fromMessage m)]
-        where resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac
+           fs <- (M.keys . W.floating) `fmap` gets windowset
+           return $ ms >>= unfloat fs >>= handleMesg
+        where handleMesg s = msum [fmap resize (fromMessage m)
+                                  ,fmap (\x -> mresize x s) (fromMessage m)
+                                  ,fmap incmastern (fromMessage m)]
+              unfloat fs s = if W.focus s `elem` fs
+                               then Nothing
+                               else Just (s { W.up = (W.up s) \\ fs
+                                            , W.down = (W.down s) \\ fs })
+              resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac
               resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac
               mresize MirrorShrink s = mresize' s delta
               mresize MirrorExpand s = mresize' s (0-delta)

XMonad/Layout/ResizeScreen.hs

@@ -0,0 +1,77 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ResizeScreen
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout transformer to have a layout respect a given screen
+-- geometry. Mostly used with "Decoration" (the Horizontal and the
+-- Vertical version will react to SetTheme and change their dimension
+-- accordingly.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.ResizeScreen
+    ( -- * Usage:
+      -- $usage
+      resizeHorizontal, resizeVertical
+    , resizeHorizontalRight, resizeVerticalBottom
+    , withNewRectangle
+    , ResizeScreen (..)
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+
+-- $usage
+-- You can use this module by importing it into your
+-- @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Layout.ResizeScreen
+--
+-- and modifying your layoutHook as follows (for example):
+--
+-- > layoutHook = resizeHorizontal 40 Full
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a
+resizeHorizontal i = ModifiedLayout (ResizeScreen L i)
+
+resizeVertical :: Int -> l a -> ModifiedLayout ResizeScreen l a
+resizeVertical i = ModifiedLayout (ResizeScreen T i)
+
+resizeHorizontalRight :: Int -> l a -> ModifiedLayout ResizeScreen l a
+resizeHorizontalRight i = ModifiedLayout (ResizeScreen R i)
+
+resizeVerticalBottom :: Int -> l a -> ModifiedLayout ResizeScreen l a
+resizeVerticalBottom i = ModifiedLayout (ResizeScreen B i)
+
+withNewRectangle  :: Rectangle -> l a -> ModifiedLayout ResizeScreen l a
+withNewRectangle r = ModifiedLayout (WithNewScreen r)
+
+data ResizeScreen a = ResizeScreen ResizeMode Int
+                    | WithNewScreen Rectangle
+                      deriving (Read, Show)
+
+data ResizeMode = T | B | L | R deriving (Read, Show)
+
+instance LayoutModifier ResizeScreen a where
+    modifyLayout m ws rect@(Rectangle x y w h)
+        | ResizeScreen L i <- m = resize $ Rectangle (x + fi i) y (w - fi i) h
+        | ResizeScreen R i <- m = resize $ Rectangle x          y (w - fi i) h
+        | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i)
+        | ResizeScreen B i <- m = resize $ Rectangle x  y         w (h - fi i)
+        | WithNewScreen  r <- m = resize r
+        | otherwise             = resize rect
+       where resize nr = runLayout ws nr
+
+    pureMess (ResizeScreen d _) m
+        | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t)
+    pureMess _ _ = Nothing

XMonad/Layout/ShowWName.hs

@@ -0,0 +1,105 @@
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ShowWName
+-- Copyright   :  (c) Andrea Rossato 2007
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This is a layout modifier that will show the workspace name
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.ShowWName
+    ( -- * Usage
+      -- $usage
+      showWName
+    , showWName'
+    , defaultSWNConfig
+    , SWNConfig(..)
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.Font
+import XMonad.Util.Timer
+import XMonad.Util.XUtils
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.ShowWName
+-- > myLayout = layoutHook defaultConfig
+-- > main = xmonad defaultConfig { layoutHook = showWName myLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | A layout modifier to show the workspace name when switching
+showWName :: l a -> ModifiedLayout ShowWName l a
+showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing)
+
+-- | A layout modifier to show the workspace name when switching. It
+-- is possible to provide a costum configuration.
+showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a
+showWName' c = ModifiedLayout (SWN True c Nothing)
+
+type ShowWNState = Maybe (TimerId, Window)
+data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show)
+
+data SWNConfig =
+    SWNC { swn_font    :: String   -- ^ Font name
+         , swn_bgcolor :: String   -- ^ Background color
+         , swn_color   :: String   -- ^ String color
+         , swn_fade    :: Rational -- ^ Time in seconds of the name visibility
+    } deriving (Read, Show)
+
+defaultSWNConfig :: SWNConfig
+defaultSWNConfig =
+    SWNC { swn_font    = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+         , swn_bgcolor = "black"
+         , swn_color   = "white"
+         , swn_fade    = 1
+         }
+
+instance LayoutModifier ShowWName a where
+    redoLayout      sn r _ wrs = doShow sn r wrs
+
+    emptyLayoutMod  sn r   wrs = doShow sn r wrs
+
+    handleMess (SWN _ c (Just (i,w))) m
+        | Just e    <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
+        | Just Hide <- fromMessage m = do deleteWindow w
+                                          return . Just $ SWN True c Nothing
+
+    handleMess (SWN _ c s) m
+        | Just Hide <- fromMessage m = return . Just $ SWN True c s
+        | otherwise                  = return Nothing
+
+doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
+doShow (SWN True  c (Just (_,w))) r wrs = deleteWindow w >> flashName c r wrs
+doShow (SWN True  c  Nothing    ) r wrs = flashName c r wrs
+doShow (SWN False _  _          ) _ wrs = return (wrs, Nothing)
+
+flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))
+flashName c (Rectangle _ _ wh ht) wrs = do
+  d <- asks display
+  n <- withWindowSet (return . S.tag . S.workspace . S.current)
+  f <- initXMF (swn_font c)
+  width   <- textWidthXMF d f n
+  (as,ds) <- textExtentsXMF f n
+  let hight = as + ds
+      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 "" "" (swn_color c) (swn_bgcolor c) AlignCenter n
+  releaseXMF f
+  io $ sync d False
+  i <- startTimer (swn_fade c)
+  return (wrs, Just $ SWN False c $ Just (i,w))

XMonad/Layout/SimpleDecoration.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.SimpleDecoration
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier for adding simple decorations to the windows of a
+-- given layout. The decorations are in the form of ion-like tabs
+-- for window titles.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.SimpleDecoration
+    ( -- * Usage:
+      -- $usage
+      simpleDeco
+    , Theme (..)
+    , defaultTheme
+    , SimpleDecoration (..)
+    , shrinkText, CustomShrink(CustomShrink)
+    , Shrinker(..)
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.SimpleDecoration
+--
+-- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to
+-- your layout:
+--
+-- > myL = simpleDeco shrinkText defaultTheme (layoutHook defaultConfig)
+-- > main = xmonad defaultConfig { layoutHook = myL }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You can also edit the default configuration options.
+--
+-- > mySDConfig = defaultTheme { inactiveBorderColor = "red"
+-- >                                  , inactiveTextColor   = "red"}
+--
+-- and
+--
+-- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultTheme)
+
+-- | Add simple decorations to windows of a layout.
+simpleDeco :: (Eq a, Shrinker s) => s -> Theme
+           -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a
+simpleDeco s c = decoration s c $ Simple True
+
+data SimpleDecoration a = Simple Bool deriving (Show, Read)
+
+instance Eq a => DecorationStyle SimpleDecoration a where
+    describeDeco _ = "Simple"
+    shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) =
+        if b then Rectangle x (y + fi dh) w (h - dh) else r
+    pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) =
+        if isInStack s w
+        then if b
+             then Just $ Rectangle x  y          nwh ht
+             else Just $ Rectangle x (y - fi ht) nwh ht
+        else Nothing
+            where nwh = min wid wh

XMonad/Layout/SimpleFloat.hs

@@ -0,0 +1,80 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.SimpleFloat
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A basic floating layout.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.SimpleFloat
+    ( -- * Usage:
+      -- $usage
+      simpleFloat
+    , simpleFloat'
+    , SimpleDecoration (..)
+    , SimpleFloat (..)
+    , shrinkText, CustomShrink(CustomShrink)
+    , Shrinker(..)
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import XMonad.Actions.MouseResize
+import XMonad.Layout.Decoration
+import XMonad.Layout.SimpleDecoration
+import XMonad.Layout.WindowArranger
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.SimpleFloat
+--
+-- Then edit your @layoutHook@ by adding the SimpleFloat layout:
+--
+-- > myLayouts = simpleFloat ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | A simple floating layout where every window is placed according
+-- to the window's initial attributes.
+--
+-- This version is decorated with the 'SimpleDecoration' style.
+simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
+               (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+simpleFloat = decoration shrinkText defaultTheme (Simple False) (mouseResize $ windowArrangeAll $ SF 20)
+
+-- | Same as 'simpleFloat', but with the possibility of setting a
+-- custom shrinker and a custom theme.
+simpleFloat' :: (Eq a, Shrinker s) => s -> Theme ->
+               ModifiedLayout (Decoration SimpleDecoration s)
+               (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
+simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c))
+
+data SimpleFloat a = SF Dimension deriving (Show, Read)
+instance LayoutClass SimpleFloat Window where
+    description _ = "Float"
+    doLayout (SF i) sc (S.Stack w l r) = do
+        wrs <- mapM (getSize i sc) (w : reverse l ++ r)
+        return (wrs, Nothing)
+
+getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle)
+getSize i (Rectangle rx ry _ _) w = do
+  d  <- asks display
+  bw <- asks (borderWidth . config)
+  wa <- io $ getWindowAttributes d w
+  let ny = ry + fi i
+      x  =  max rx $ fi $ wa_x wa
+      y  =  max ny $ fi $ wa_y wa
+      wh = (fi $ wa_width  wa) + (bw * 2)
+      ht = (fi $ wa_height wa) + (bw * 2)
+  return (w, Rectangle x y wh ht)

XMonad/Layout/Simplest.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Simplest
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A very simple layout. The simplest, afaik.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Simplest
+    ( -- * Usage:
+      -- $usage
+      Simplest (..)
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Simplest
+--
+-- Then edit your @layoutHook@ by adding the Simplest layout:
+--
+-- > myLayouts = Simplest ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data Simplest a = Simplest deriving (Show, Read)
+instance LayoutClass Simplest a where
+    pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec)

XMonad/Layout/SimplestFloat.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.SimplestFloat
+-- Copyright   :  (c) 2008 Jussi Mäki
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  joamaki@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A basic floating layout like SimpleFloat but without the decoration.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.SimplestFloat
+    ( -- * Usage:
+      -- $usage
+      simplestFloat
+    , SimplestFloat
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import XMonad.Layout.WindowArranger
+import XMonad.Layout.LayoutModifier
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.SimplestFloat
+--
+-- Then edit your @layoutHook@ by adding the SimplestFloat layout:
+--
+-- > myLayouts = simplestFloat ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- | A simple floating layout where every window is placed according
+-- to the window's initial attributes.
+simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a
+simplestFloat = (windowArrangeAll $ SF)
+
+data SimplestFloat a = SF deriving (Show, Read)
+instance LayoutClass SimplestFloat Window where
+    doLayout SF sc (S.Stack w l r) = do wrs <- mapM (getSize sc) (w : reverse l ++ r)
+                                        return (wrs, Nothing)
+    description _ = "SimplestFloat"
+
+getSize :: Rectangle -> Window -> X (Window,Rectangle)
+getSize (Rectangle rx ry _ _) w = do
+  d  <- asks display
+  bw <- asks (borderWidth . config)
+  wa <- io $ getWindowAttributes d w
+  let x  =  max rx $ fi $ wa_x wa
+      y  =  max ry $ fi $ wa_y wa
+      wh = (fi $ wa_width  wa) + (bw * 2)
+      ht = (fi $ wa_height wa) + (bw * 2)
+  return (w, Rectangle x y wh ht)
+  where
+    fi x = fromIntegral x

XMonad/Layout/Spiral.hs

@@ -10,7 +10,7 @@
 -- Stability   :  stable
 -- Portability :  portable
 --
--- Spiral adds a spiral tiling layout
+-- A spiral tiling layout.
 --
 -----------------------------------------------------------------------------
 
@@ -31,11 +31,10 @@ import XMonad.StackSet ( integrate )
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Layout.Spiral
--- > import Data.Ratio
 --
 -- Then edit your @layoutHook@ by adding the Spiral layout:
 --
--- > myLayouts =  spiral (1 % 1) ||| etc..
+-- > myLayouts =  spiral (6/7) ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
 -- For more detailed instructions on editing the layoutHook see:
@@ -59,9 +58,18 @@ blend scale ratios = zipWith (+) ratios scaleFactors
       step = (scale - (1 % 1)) / (fromIntegral len)
       scaleFactors = map (* step) . reverse . take len $ [0..]
 
+-- | A spiral layout.  The parameter controls the size ratio between
+--   successive windows in the spiral.  Sensible values range from 0
+--   up to the aspect ratio of your monitor (often 4\/3).
+--
+--   By default, the spiral is counterclockwise, starting to the east.
+--   See also 'spiralWithDir'.
 spiral :: Rational -> SpiralWithDir a
 spiral = spiralWithDir East CW
 
+-- | Create a spiral layout, specifying the starting cardinal direction,
+--   the spiral direction (clockwise or counterclockwise), and the
+--   size ratio.
 spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a
 spiralWithDir = SpiralWithDir
 

XMonad/Layout/Square.hs

@@ -6,7 +6,7 @@
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --

XMonad/Layout/StackTile.hs

@@ -0,0 +1,64 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.StackTile
+-- Copyright   :  (c) Rickard Gustafsson <acura@allyourbase.se>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Rickard Gustafsson <acura@allyourbase.se>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A stacking layout, like dishes but with the ability to resize master pane.
+-- Moastly usefull on small screens.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.StackTile (
+                                    -- * Usage
+                                    -- $usage
+                                    StackTile(..)
+                                   ) where
+
+import XMonad hiding (tile)
+import qualified XMonad.StackSet as W
+import Control.Monad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.StackTile
+--
+-- Then edit your @layoutHook@ by adding the StackTile layout:
+--
+-- > myLayouts =  StackTile 1 (3/100) (1/2) ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read)
+
+instance LayoutClass StackTile a where
+    pureLayout (StackTile nmaster _ frac) r s = zip ws rs
+      where ws = W.integrate s
+            rs = tile frac r nmaster (length ws)
+
+    pureMessage (StackTile nmaster delta frac) m =
+            msum [fmap resize     (fromMessage m)
+                 ,fmap incmastern (fromMessage m)]
+
+      where resize Shrink             = StackTile nmaster delta (max 0 $ frac-delta)
+            resize Expand             = StackTile nmaster delta (min 1 $ frac+delta)
+            incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac
+
+    description _ = "StackTile"
+
+tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
+tile f r nmaster n = if n <= nmaster || nmaster == 0
+    then splitHorizontally n r
+    else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
+  where (r1,r2) = splitVerticallyBy f r

XMonad/Layout/TabBarDecoration.hs

@@ -0,0 +1,78 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.TabBarDecoration
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier to add a bar of tabs to your layouts.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.TabBarDecoration
+    ( -- * Usage
+      -- $usage
+      simpleTabBar, tabBar
+    , defaultTheme, shrinkText
+    , TabBarDecoration (..), XPPosition (..)
+    , module XMonad.Layout.ResizeScreen
+    ) where
+
+import Data.List
+import XMonad
+import qualified XMonad.StackSet as S
+import XMonad.Layout.Decoration
+import XMonad.Layout.ResizeScreen
+import XMonad.Prompt ( XPPosition (..) )
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.TabBarDecoration
+--
+-- Then edit your @layoutHook@ by adding the layout you want:
+--
+-- > main = xmonad defaultConfig { layoutHook = simpleTabBar $ layoutHook defaultConfig}
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- 'tabBar' will give you the possibility of setting a custom shrinker
+-- and a custom theme.
+--
+-- The deafult theme can be dynamically change with the xmonad theme
+-- selector. See "XMonad.Prompt.Theme". For more themse, look at
+-- "XMonad.Util.Themes"
+
+-- | Add, on the top of the screen, a simple bar of tabs to a given
+-- | layout, with the default theme and the default shrinker.
+simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)
+                (ModifiedLayout ResizeScreen l) a
+simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) . resizeVertical 20
+
+-- | Same of 'simpleTabBar', but with the possibility of setting a
+-- custom shrinker, a custom theme and the position: 'Top' or
+-- 'Bottom'.
+tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a
+tabBar s t p = decoration s t (TabBar p)
+
+data TabBarDecoration a = TabBar XPPosition deriving (Read, Show)
+
+instance Eq a => DecorationStyle TabBarDecoration a where
+    describeDeco  _ = "TabBar"
+    shrink    _ _ r = r
+    decorationMouseDragHook _ _ _ = return ()
+    pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) =
+        if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing
+        where wrs = S.integrate s
+              loc i = (wh * fi i) `div` max 1 (fi $ length wrs)
+              wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` wrs
+              ny  = case p of
+                     Top    -> y
+                     Bottom -> y + fi ht - fi dht
+              nx  = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` wrs

XMonad/Layout/Tabbed.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Tabbed
@@ -13,25 +14,27 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.Tabbed (
-                             -- * Usage:
-                             -- $usage
-                             tabbed
-                            , shrinkText, CustomShrink(CustomShrink)
-                            , TConf (..), defaultTConf
-                            , Shrinker(..)
-                            ) where
+module XMonad.Layout.Tabbed
+    ( -- * Usage:
+      -- $usage
+      simpleTabbed, tabbed, addTabs
+    , simpleTabbedAlways, tabbedAlways, addTabsAlways
+    , simpleTabbedBottom, tabbedBottom, addTabsBottom
+    , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways
+    , Theme (..)
+    , defaultTheme
+    , TabbedDecoration (..)
+    , shrinkText, CustomShrink(CustomShrink)
+    , Shrinker(..)
+    ) where
 
 import Data.Maybe
 import Data.List
 
 import XMonad
-import qualified XMonad.StackSet as W
-
-import XMonad.Util.NamedWindows
-import XMonad.Util.Invisible
-import XMonad.Util.XUtils
-import XMonad.Util.Font
+import qualified XMonad.StackSet as S
+import XMonad.Layout.Decoration
+import XMonad.Layout.Simplest ( Simplest(Simplest) )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -40,189 +43,129 @@ import XMonad.Util.Font
 --
 -- Then edit your @layoutHook@ by adding the Tabbed layout:
 --
--- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc..
+-- > myLayouts = simpleTabbed ||| Full ||| etc..
+--
+-- or, if you want a specific theme for you tabbed layout:
+--
+-- > myLayouts = tabbed shrinkText defaultTheme ||| Full ||| etc..
+--
+-- and then:
+--
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
+-- The default Tabbar behaviour is to hide it when only one window is open
+-- on the workspace.  To have it always shown, use one of the layouts or
+-- modifiers ending in "Always".
+--
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 --
 -- You can also edit the default configuration options.
 --
--- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000"
--- >                            , activeTextColor = "#00FF00"}
+-- > myTabConfig = defaultTheme { inactiveBorderColor = "#FF0000"
+-- >                                   , activeTextColor = "#00FF00"}
 --
 -- and
 --
 -- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..
 
-tabbed :: Shrinker s => s -> TConf -> Tabbed s a
-tabbed s t = Tabbed (I Nothing) s t
+-- Layouts
 
-data TConf =
-    TConf { activeColor         :: String
-          , inactiveColor       :: String
-          , activeBorderColor   :: String
-          , inactiveTextColor   :: String
-          , inactiveBorderColor :: String
-          , activeTextColor     :: String
-          , fontName            :: String
-          , tabSize             :: Int
-          } deriving (Show, Read)
+-- | A tabbed layout with the default xmonad Theme.
+--
+-- This is a minimal working configuration:
+--
+-- > import XMonad
+-- > import XMonad.Layout.DecorationMadness
+-- > main = xmonad defaultConfig { layoutHook = simpleTabbed }
+simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
+simpleTabbed = tabbed shrinkText defaultTheme
 
-defaultTConf :: TConf
-defaultTConf =
-    TConf { activeColor         = "#999999"
-          , inactiveColor       = "#666666"
-          , activeBorderColor   = "#FFFFFF"
-          , inactiveBorderColor = "#BBBBBB"
-          , activeTextColor     = "#FFFFFF"
-          , inactiveTextColor   = "#BFBFBF"
-          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-          , tabSize             = 20
-          }
+simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
+simpleTabbedAlways = tabbedAlways shrinkText defaultTheme
 
-data TabState =
-    TabState { tabsWindows :: [(Window,Window)]
-             , scr         :: Rectangle
-             , font        :: XMonadFont
-    }
+-- | A bottom-tabbed layout with the default xmonad Theme.
+simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
+simpleTabbedBottom = tabbedBottom shrinkText defaultTheme
 
-data Tabbed s a =
-    Tabbed (Invisible Maybe TabState) s TConf
-    deriving (Show, Read)
+-- | A bottom-tabbed layout with the default xmonad Theme.
+simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
+simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme
 
-instance Shrinker s => LayoutClass (Tabbed s) Window where
-    doLayout (Tabbed ist ishr conf) = doLay ist ishr conf
-    handleMessage                   = handleMess
-    description _                   = "Tabbed"
+-- | A layout decorated with tabs and the possibility to set a custom
+-- shrinker and theme.
+tabbed     :: (Eq a, Shrinker s) => s -> Theme 
+           -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbed s c = addTabs s c Simplest
 
-doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf
-      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window))
-doLay ist ishr c sc (W.Stack w [] []) = do
-  whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st)
-  return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c)
-doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
-  let ws = W.integrate s
-      width = wid `div` fromIntegral (length ws)
-  -- initialize state
-  st <- case ist of
-          (I Nothing  ) -> initState c sc ws
-          (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc
-                           then return ts
-                           else do mapM_ deleteWindow (map fst $ tabsWindows ts)
-                                   tws <- createTabs c sc ws
-                                   return (ts {scr = sc, tabsWindows = zip tws ws})
-  mapM_ showWindow $ map fst $ tabsWindows st
-  mapM_ (updateTab ishr c (font st) width) $ tabsWindows st
-  return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c))
+tabbedAlways     :: (Eq a, Shrinker s) => s -> Theme 
+                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbedAlways s c = addTabsAlways s c Simplest
 
-handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window))
-handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m
-    | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e     >> return Nothing
-    | Just Hide             == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing
-    | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws
-                                                  releaseXMF (font st)
-                                                  return $ Just $ Tabbed (I Nothing) ishr conf
-handleMess _ _  = return Nothing
+-- | A layout decorated with tabs at the bottom and the possibility to set a custom
+-- shrinker and theme.
+tabbedBottom     :: (Eq a, Shrinker s) => s -> Theme 
+                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbedBottom s c = addTabsBottom s c Simplest
 
-handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X ()
--- button press
-handleEvent ishr conf (TabState    {tabsWindows = tws,   scr          = screen, font         = fs})
-                      (ButtonEvent {ev_window   = thisw, ev_subwindow = thisbw, ev_event_type = t})
-    | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl  = do
-  case lookup thisw tws of
-    Just x  -> do focus x
-                  updateTab ishr conf fs width (thisw, x)
-    Nothing -> return ()
-    where
-      width = rect_width screen`div` fromIntegral (length tws)
+tabbedBottomAlways     :: (Eq a, Shrinker s) => s -> Theme 
+                       -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbedBottomAlways s c = addTabsBottomAlways s c Simplest
 
-handleEvent ishr conf (TabState {tabsWindows = tws,   scr           = screen, font = fs})
-                      (AnyEvent {ev_window   = thisw, ev_event_type = t                })
--- expose
-    | thisw `elem` (map fst tws) && t == expose         = do
-  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)
-    where
-      width = rect_width screen`div` fromIntegral (length tws)
+-- Layout Modifiers
 
--- propertyNotify
-handleEvent ishr conf (TabState      {tabsWindows = tws, scr = screen, font = fs})
-                      (PropertyEvent {ev_window   = thisw})
-    | thisw `elem` (map snd tws) = do
-  let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw)
-  updateTab ishr conf fs width tabwin
-    where width = rect_width screen `div` fromIntegral (length tws)
--- expose
-handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs})
-                      (ExposeEvent {ev_window   = thisw})
-    | thisw `elem` (map fst tws) = do
-  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)
-    where width = rect_width screen `div` fromIntegral (length tws)
-handleEvent _ _ _ _ =  return ()
+-- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout.
+addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+        -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabs = createTabs WhenPlural Top
 
-initState :: TConf -> Rectangle -> [Window] -> X TabState
-initState conf sc ws = do
-  fs  <- initXMF (fontName conf)
-  tws <- createTabs conf sc ws
-  return $ TabState (zip tws ws) sc fs
+addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+              -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabsAlways = createTabs Always Top
 
-createTabs :: TConf -> Rectangle -> [Window] -> X [Window]
-createTabs _ _ [] = return []
-createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do
-  let wid    = wh `div` (fromIntegral $ length owl)
-      height = fromIntegral $ tabSize c
-      mask   = Just (exposureMask .|. buttonPressMask)
-  d  <- asks display
-  w  <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c)
-  io $ restackWindows d $ w : [ow]
-  ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows
-  return (w:ws)
+-- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout.
+addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+              -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabsBottom = createTabs WhenPlural Bottom
 
-updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X ()
-updateTab ishr c fs wh (tabw,ow) = do
-  nw <- getName ow
-  let ht                   = fromIntegral $ tabSize c :: Dimension
-      focusColor win ic ac = (maybe ic (\focusw -> if focusw == win
-                                                   then ac else ic) . W.peek)
-                             `fmap` gets windowset
-  (bc',borderc',tc') <- focusColor ow
-                           (inactiveColor c, inactiveBorderColor c, inactiveTextColor c)
-                           (activeColor   c, activeBorderColor   c, activeTextColor   c)
-  dpy <- asks display
-  let s = shrinkIt ishr
-  name <- shrinkWhile s (\n -> do
-			   size <- io $ textWidthXMF dpy fs n
-			   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
-  paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name
+addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+                    -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabsBottomAlways = createTabs Always Bottom
 
-shrink :: TConf -> Rectangle -> Rectangle
-shrink c (Rectangle x y w h) =
-    Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
 
-shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
-shrinkWhile sh p x = sw $ sh x
-    where sw [n] = return n
-          sw [] = return ""
-          sw (n:ns) = do
-	                cond <- p n
-			if cond
-			  then sw ns
-			  else return n
+-- Tab creation abstractions.  Internal use only.
 
-data CustomShrink = CustomShrink
-instance Show CustomShrink where show _ = ""
-instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)]
+-- Create tabbar when required at the given location with the given
+-- shrinker and theme to the supplied layout.
+createTabs                ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> TabbarLocation -> s
+                          -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a
+createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l
 
-class (Read s, Show s) => Shrinker s where
-    shrinkIt :: s -> String -> [String]
+data TabbarLocation = Top | Bottom deriving (Read,Show)
 
-data DefaultShrinker = DefaultShrinker
-instance Show DefaultShrinker where show _ = ""
-instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)]
-instance Shrinker DefaultShrinker where
-    shrinkIt _ "" = [""]
-    shrinkIt s cs = cs : shrinkIt s (init cs)
+data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq)
 
-shrinkText :: DefaultShrinker
-shrinkText = DefaultShrinker
+data TabbedDecoration a = Tabbed TabbarLocation TabbarShown deriving (Read, Show)
+
+instance Eq a => DecorationStyle TabbedDecoration a where
+    describeDeco (Tabbed Top _ ) = "Tabbed"
+    describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom"
+    decorationMouseDragHook _ _ _ = return ()
+    pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) 
+        = if ((sh == Always && numWindows > 0) || numWindows > 1)
+          then Just $ case lc of
+                        Top -> upperTab
+                        Bottom -> lowerTab
+          else Nothing
+        where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s)
+              loc i = x + fi ((wh * fi i) `div` max 1 (fi $ length ws))
+              wid = fi $ maybe x (\i -> loc (i+1) - loc i) $ w `elemIndex` ws
+              nx  = maybe x loc $ w `elemIndex` ws
+              upperTab = Rectangle nx y wid (fi ht)
+              lowerTab = Rectangle nx (y+fi(hh-ht)) wid (fi ht)
+              numWindows = length ws
+    shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h) 
+        = case loc of
+            Top -> Rectangle x (y + fi dh) w (h - dh)
+            Bottom -> Rectangle x y w (h - dh)

XMonad/Layout/ThreeColumns.hs

@@ -34,16 +34,14 @@ import Control.Monad
 --
 -- Then edit your @layoutHook@ by adding the ThreeCol layout:
 --
--- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc..
+-- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
--- Use @True@ as the last argument to get a wide layout.
---
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read)
+data ThreeCol a = ThreeCol !Int !Rational !Rational deriving (Show,Read)
 
 instance LayoutClass ThreeCol a where
     doLayout (ThreeCol nmaster _ frac) r =

XMonad/Layout/ToggleLayouts.hs

@@ -7,7 +7,7 @@
 -- Copyright    : (c) David Roundy <droundy@darcs.net>
 -- License      : BSD
 --
--- Maintainer   : David Roundy <droundy@darcs.net>
+-- Maintainer   : none
 -- Stability    : unstable
 -- Portability  : portable
 --
@@ -21,6 +21,7 @@ module XMonad.Layout.ToggleLayouts (
     ) where
 
 import XMonad
+import XMonad.StackSet (Workspace (..))
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -56,10 +57,11 @@ toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleL
 toggleLayouts = ToggleLayouts False
 
 instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where
-    doLayout (ToggleLayouts True lt lf) r s = do (ws,mlt') <- doLayout lt r s
-                                                 return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')
-    doLayout (ToggleLayouts False lt lf) r s = do (ws,mlf') <- doLayout lf r s
-                                                  return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')
+    runLayout (Workspace i (ToggleLayouts True lt lf) ms) r = do (ws,mlt') <- runLayout (Workspace i lt ms) r
+                                                                 return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')
+
+    runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r
+                                                                  return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')
     description (ToggleLayouts True lt _) = description lt
     description (ToggleLayouts False _ lf) = description lf
     handleMessage (ToggleLayouts bool lt lf) m

XMonad/Layout/TwoPane.hs

@@ -3,10 +3,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.TwoPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 -- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -59,3 +59,4 @@ instance LayoutClass TwoPane a where
                    Just Expand -> Just (TwoPane delta (split + delta))
                    _           -> Nothing
 
+    description _ = "TwoPane"

XMonad/Layout/WindowArranger.hs

@@ -0,0 +1,209 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
+{-# LANGUAGE PatternGuards           #-}
+{-# LANGUAGE FlexibleInstances       #-}
+{-# LANGUAGE MultiParamTypeClasses   #-}
+{-# LANGUAGE TypeSynonymInstances    #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.WindowArranger
+-- Copyright   :  (c) Andrea Rossato 2007
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This is a pure layout modifier that will let you move and resize
+-- windows with the keyboard in any layout.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.WindowArranger
+    ( -- * Usage
+      -- $usage
+      windowArrange
+    , windowArrangeAll
+    , WindowArrangerMsg (..)
+    , WindowArranger
+    , memberFromList
+    , listFromList
+    , diff
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import XMonad.Layout.LayoutModifier
+import XMonad.Util.XUtils (fi)
+
+import Control.Arrow
+import Data.List
+import Data.Maybe
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.WindowArranger
+-- > myLayout = layoutHook defaultConfig
+-- > main = xmonad defaultConfig { layoutHook = windowArrange myLayout }
+--
+-- or
+--
+-- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You may also want to define some key binding to move or resize
+-- windows. These are good defaults:
+--
+-- >        , ((modMask x .|. controlMask              , xK_s    ), sendMessage  Arrange         )
+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_s    ), sendMessage  DeArrange       )
+-- >        , ((modMask x .|. controlMask              , xK_Left ), sendMessage (MoveLeft      1))
+-- >        , ((modMask x .|. controlMask              , xK_Right), sendMessage (MoveRight     1))
+-- >        , ((modMask x .|. controlMask              , xK_Down ), sendMessage (MoveDown      1))
+-- >        , ((modMask x .|. controlMask              , xK_Up   ), sendMessage (MoveUp        1))
+-- >        , ((modMask x                 .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft  1))
+-- >        , ((modMask x                 .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1))
+-- >        , ((modMask x                 .|. shiftMask, xK_Down ), sendMessage (IncreaseDown  1))
+-- >        , ((modMask x                 .|. shiftMask, xK_Up   ), sendMessage (IncreaseUp    1))
+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft  1))
+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1))
+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown  1))
+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage (DecreaseUp    1))
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | A layout modifier to float the windows in a workspace
+windowArrange :: l a -> ModifiedLayout WindowArranger l a
+windowArrange = ModifiedLayout (WA True False [])
+
+-- | A layout modifier to float all the windows in a workspace
+windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a
+windowArrangeAll = ModifiedLayout (WA True True [])
+
+data WindowArrangerMsg = DeArrange
+                       | Arrange
+                       | IncreaseLeft  Int
+                       | IncreaseRight Int
+                       | IncreaseUp    Int
+                       | IncreaseDown  Int
+                       | DecreaseLeft  Int
+                       | DecreaseRight Int
+                       | DecreaseUp    Int
+                       | DecreaseDown  Int
+                       | MoveLeft      Int
+                       | MoveRight     Int
+                       | MoveUp        Int
+                       | MoveDown      Int
+                       | SetGeometry   Rectangle
+                         deriving ( Typeable )
+instance Message WindowArrangerMsg
+
+data ArrangedWindow a = WR   (a, Rectangle)
+                      | AWR  (a, Rectangle)
+                        deriving (Read, Show)
+
+type ArrangeAll = Bool
+data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
+
+instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
+    pureModifier (WA True b   []) _  _              wrs = arrangeWindows b wrs
+
+    pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs
+        where
+          wins         = map fst       *** map awrWin
+          update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)
+          process      = wins &&&  id  >>> first diff   >>> uncurry update >>>
+                         replaceWR wrs >>> putOnTop w   >>> map fromAWR &&& Just . WA True b
+
+    pureModifier _ _ _ wrs = (wrs, Nothing)
+
+    pureMess (WA True b (wr:wrs)) m
+        -- increase the window's size
+        | Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y        (w + fi i) h
+        | Just (IncreaseLeft  i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y        (w + fi i) h
+        | Just (IncreaseUp    i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y - fi i) w        (h + fi i)
+        | Just (IncreaseDown  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y         w        (h + fi i)
+        -- decrease the window's size
+        | Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y        (chk  w i) h
+        | Just (DecreaseLeft  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y        (chk  w i) h
+        | Just (DecreaseUp    i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y         w        (chk h i)
+        | Just (DecreaseDown  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y + fi i) w        (chk h i)
+        --move the window around
+        | Just (MoveRight     i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y         w         h
+        | Just (MoveLeft      i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y         w         h
+        | Just (MoveUp        i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y - fi i) w         h
+        | Just (MoveDown      i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y + fi i) w         h
+
+        where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs
+              fm             = fromMessage m
+              fa             = fromAWR     wr
+              chk        x y = fi $ max 1 (fi x - y)
+
+    pureMess (WA t b (wr:wrs)) m
+        | Just (SetGeometry   r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs
+
+    pureMess (WA _ b l) m
+        | Just DeArrange <- fromMessage m = Just $ WA False b l
+        | Just Arrange   <- fromMessage m = Just $ WA True  b l
+        | otherwise                       = Nothing
+
+arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
+arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs))
+    where t = if b then AWR else WR
+
+fromAWR :: ArrangedWindow a -> (a, Rectangle)
+fromAWR (WR   x) = x
+fromAWR (AWR  x) = x
+
+awrWin :: ArrangedWindow a -> a
+awrWin = fst . fromAWR
+
+getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
+getAWR = memberFromList awrWin (==)
+
+getWR ::  Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)]
+getWR = memberFromList fst (==)
+
+mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]
+mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w
+    where t = if b then AWR else WR
+
+removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
+removeAWRs = listFromList awrWin notElem
+
+putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
+putOnTop w awrs = awr ++ nawrs
+    where awr   = getAWR w awrs
+          nawrs = filter ((/=w) . awrWin) awrs
+
+replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
+replaceWR wrs = foldr r []
+    where r x xs
+              | WR wr <- x = case fst wr `elemIndex` map fst wrs of
+                               Just i  -> (WR $ wrs !! i):xs
+                               Nothing -> x:xs
+              | otherwise  = x:xs
+
+-- | Given a function to be applied to each member of a list, and a
+-- function to check a condition by processing this transformed member
+-- with the members of a list, you get the list of members that
+-- satisfy the condition.
+listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
+listFromList f g l = foldr (h l) []
+    where h x y ys = if g (f y) x then y:ys else ys
+
+-- | Given a function to be applied to each member of ta list, and a
+-- function to check a condition by processing this transformed member
+-- with something, you get the first member that satisfy the condition,
+-- or an empty list.
+memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
+memberFromList f g l = foldr (h l) []
+    where h x y ys = if g (f y) x then [y] else ys
+
+-- | Get the list of elements to be deleted and the list ef elements to
+-- be added to the first list in order to get the second list.
+diff :: Eq a => ([a],[a]) -> ([a],[a])
+diff (x,y) = (x \\ y, y \\ x)

XMonad/Layout/WindowNavigation.hs

@@ -7,7 +7,7 @@
 -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -32,6 +32,8 @@ import XMonad.Layout.LayoutModifier
 import XMonad.Util.Invisible
 import XMonad.Util.XUtils
 
+import XMonad.Hooks.ManageDocks (Direction(..))
+
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
@@ -67,7 +69,6 @@ data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeab
 instance Typeable a => Message (MoveWindowToWindow a)
 
 data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable )
-data Direction = U | D | R | L deriving ( Read, Show, Eq )
 instance Message Navigate
 
 data WNConfig =
@@ -92,7 +93,7 @@ navigateBrightness f | f > 1 = navigateBrightness 1
 navigateBrightness f = defaultWNConfig { brightness = Just f }
 
 defaultWNConfig :: WNConfig
-defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
+defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
 
 data NavigationState a = NS Point [(a,Rectangle)]
 
@@ -105,7 +106,7 @@ configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout W
 configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
 
 instance LayoutModifier WindowNavigation Window where
-    redoLayout (WindowNavigation conf (I state)) rscr s wrs =
+    redoLayout (WindowNavigation conf (I state)) rscr s origwrs =
         do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask
            [uc,dc,lc,rc] <-
                case brightness conf of
@@ -118,25 +119,27 @@ instance LayoutModifier WindowNavigation Window where
                dirc L = lc
                dirc R = rc
            let w    = W.focus s
-               r    = case filter ((==w).fst) wrs of ((_,x):_) -> x
-                                                     []        -> rscr
+               r    = case filter ((==w).fst) origwrs of ((_,x):_) -> x
+                                                         []        -> rscr
                pt   = case state of Just (NS ptold _) | ptold `inrect` r -> ptold
                                     _ -> center r
-               wrs' = filter ((/=w) . fst) wrs
+               existing_wins = W.integrate s
+               wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $
+                     filter ((/=w) . fst) origwrs
                wnavigable = nub $ concatMap
-                            (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L]
+                            (\d -> truncHead $ navigable d pt wrs) [U,D,R,L]
                wnavigablec = nub $ concatMap
                             (\d -> map (\(win,_) -> (win,dirc d)) $
-                                   truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L]
+                                   truncHead $ navigable d pt wrs) [U,D,R,L]
                wothers = case state of Just (NS _ wo) -> map fst wo
                                        _              -> []
            mapM_ (sc nbc) (wothers \\ map fst wnavigable)
            mapM_ (\(win,c) -> sc c win) wnavigablec
-           return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
+           return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
 
     handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
         | Just (Go d) <- fromMessage m =
-                         case sortby d $ filter (inr d pt . snd) wrs of
+                         case navigable d pt wrs of
                          []        -> return Nothing
                          ((w,r):_) -> do modify focusWindowHere
                                          return $ Just $ Left $ WindowNavigation conf $ I $ Just $
@@ -152,7 +155,7 @@ instance LayoutModifier WindowNavigation Window where
                                    has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)
 
         | Just (Swap d) <- fromMessage m =
-             case sortby d $ filter (inr d pt . snd) wrs of
+             case navigable d pt wrs of
              []        -> return Nothing
              ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st
                                  swapw y x | x == w = y
@@ -168,7 +171,7 @@ instance LayoutModifier WindowNavigation Window where
                              windows $ W.modify' swap
                              return Nothing
         | Just (Move d) <- fromMessage m =
-             case sortby d $ filter (inr d pt . snd) wrs of
+             case navigable d pt wrs of
              []        -> return Nothing
              ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)
                              return $ do st <- mst
@@ -181,6 +184,9 @@ instance LayoutModifier WindowNavigation Window where
                handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
     handleMessOrMaybeModifyIt _ _ = return Nothing
 
+navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
+navigable d pt = sortby d . filter (inr d pt . snd)
+
 truncHead :: [a] -> [a]
 truncHead (x:_) = [x]
 truncHead [] = []

XMonad/Layout/WorkspaceDir.hs

@@ -7,7 +7,7 @@
 -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Maintainer  :  none
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -30,12 +30,14 @@ module XMonad.Layout.WorkspaceDir (
                                   ) where
 
 import System.Directory ( setCurrentDirectory, getCurrentDirectory )
+import Control.Monad ( when )
 
-import XMonad
+import XMonad hiding ( focus )
 import XMonad.Util.Run ( runProcessWithInput )
 import XMonad.Prompt ( XPConfig )
 import XMonad.Prompt.Directory ( directoryPrompt )
 import XMonad.Layout.LayoutModifier
+import XMonad.StackSet ( tag, current, workspace )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -66,8 +68,10 @@ instance Message Chdir
 
 data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show )
 
-instance LayoutModifier WorkspaceDir a where
-    hook (WorkspaceDir s) = scd s
+instance LayoutModifier WorkspaceDir Window where
+    modifyLayout (WorkspaceDir d) w r = do tc <- gets (tag.workspace.current.windowset)
+                                           when (tc == tag w) $ scd d
+                                           runLayout w r
     handleMess (WorkspaceDir _) m
         | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd
                                                 return $ Just $ WorkspaceDir wd'

XMonad/Prompt.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE ExistentialQuantification #-}
-
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Prompt
@@ -14,32 +13,38 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Prompt (
-                             -- * Usage
-                             -- $usage
-                             mkXPrompt
-                             , mkXPromptWithReturn
-                             , defaultXPConfig
-                             , mkComplFunFromList
-                             , XPType (..)
-                             , XPPosition (..)
-                             , XPConfig (..)
-                             , XPrompt (..)
-                             , ComplFunction
-                             -- * X Utilities
-                             -- $xutils
-                             , mkUnmanagedWindow
-                             , fillDrawable
-                             -- * Other Utilities
-                             -- $utils
-                             , getLastWord
-                             , skipLastWord
-                             , splitInSubListsAt
-                             , breakAtSpace
-                             , newIndex
-                             , newCommand
-                             , uniqSort
-                             ) where
+module XMonad.Prompt
+    ( -- * Usage
+      -- $usage
+      mkXPrompt
+    , mkXPromptWithReturn
+    , defaultXPConfig
+    , XPType (..)
+    , XPPosition (..)
+    , XPConfig (..)
+    , XPrompt (..)
+    , ComplFunction
+    -- * X Utilities
+    -- $xutils
+    , mkUnmanagedWindow
+    , fillDrawable
+    -- * Other Utilities
+    -- $utils
+    , mkComplFunFromList
+    , mkComplFunFromList'
+    -- * @nextCompletion@ implementations
+    , getNextOfLastWord
+    , getNextCompletion
+    -- * List utilities
+    , getLastWord
+    , skipLastWord
+    , splitInSubListsAt
+    , breakAtSpace
+    , uniqSort
+    , decodeInput
+    , encodeOutput
+    , historyCompletion
+    ) where
 
 import XMonad  hiding (config, io)
 import qualified XMonad.StackSet as W
@@ -47,10 +52,12 @@ import XMonad.Util.Font
 import XMonad.Util.XSelection (getSelection)
 
 import Control.Arrow ((&&&))
+import Control.Concurrent (threadDelay)
 import Control.Monad.Reader
 import Control.Monad.State
 import Control.Applicative ((<$>))
 import Data.Char
+import Data.Bits ((.&.))
 import Data.Maybe
 import Data.List
 import Data.Set (fromList, toList)
@@ -70,17 +77,17 @@ type XP = StateT XPState IO
 
 data XPState =
     XPS { dpy                :: Display
-        , rootw              :: Window
-        , win                :: Window
-        , screen             :: Rectangle
+        , rootw              :: !Window
+        , win                :: !Window
+        , screen             :: !Rectangle
         , complWin           :: Maybe Window
         , complWinDim        :: Maybe ComplWindowDim
         , completionFunction :: String -> IO [String]
-        , gcon               :: GC
-        , fontS              :: XMonadFont
-        , xptype             :: XPType
+        , gcon               :: !GC
+        , fontS              :: !XMonadFont
+        , xptype             :: !XPType
         , command            :: String
-        , offset             :: Int
+        , offset             :: !Int
         , history            :: [History]
         , config             :: XPConfig
         }
@@ -92,10 +99,13 @@ data XPConfig =
         , fgHLight          :: String     -- ^ Font color of a highlighted completion entry
         , bgHLight          :: String     -- ^ Background color of a highlighted completion entry
         , borderColor       :: String     -- ^ Border color
-        , promptBorderWidth :: Dimension  -- ^ Border width
+        , promptBorderWidth :: !Dimension -- ^ Border width
         , position          :: XPPosition -- ^ Position: 'Top' or 'Bottom'
-        , height            :: Dimension  -- ^ Window height
-        , historySize       :: Int        -- ^ The number of history entries to be saved
+        , height            :: !Dimension -- ^ Window height
+        , historySize       :: !Int       -- ^ The number of history entries to be saved
+        , defaultText       :: String     -- ^ The text by default in the prompt line
+        , autoComplete      :: Maybe Int  -- ^ Just x: if only one completion remains, auto-select it,
+                                          --   and delay by x microseconds
         } deriving (Show, Read)
 
 data XPType = forall p . XPrompt p => XPT p
@@ -104,7 +114,10 @@ instance Show XPType where
     show (XPT p) = showXPrompt p
 
 instance XPrompt XPType where
-    showXPrompt = show
+    showXPrompt                 = show
+    nextCompletion      (XPT t) = nextCompletion      t
+    commandToComplete   (XPT t) = commandToComplete   t
+    completionToCommand (XPT t) = completionToCommand t
 
 -- | The class prompt types must be an instance of. In order to
 -- create a prompt you need to create a data type, without parameters,
@@ -117,8 +130,33 @@ instance XPrompt XPType where
 -- >     instance XPrompt Shell where
 -- >          showXPrompt Shell = "Run: "
 class XPrompt t where
+
+    -- | This method is used to print the string to be
+    -- displayed in the command line window.
     showXPrompt :: t -> String
 
+    -- | This method is used to generate the next completion to be
+    -- printed in the command line when tab is pressed, given the
+    -- string presently in the command line and the list of
+    -- completion.
+    nextCompletion :: t -> String -> [String] -> String
+    nextCompletion t c l = getNextOfLastWord t c l
+
+    -- | This method is used to generate the string to be passed to
+    -- the completion function.
+    commandToComplete :: t -> String -> String
+    commandToComplete _ c = getLastWord c
+
+    -- | This method is used to process each completion in order to
+    -- generate the string that will be compared with the command
+    -- presently displayed in the command line. If the prompt is using
+    -- 'getNextOfLastWord' for implementing 'nextCompletion' (the
+    -- default implementation), this method is also used to generate,
+    -- from the returned completion, the string that will form the
+    -- next command line when tab is pressed.
+    completionToCommand :: t -> String -> String
+    completionToCommand _ c = c
+
 data XPPosition = Top
                 | Bottom
                   deriving (Show,Read)
@@ -135,6 +173,8 @@ defaultXPConfig =
         , position          = Bottom
         , height            = 18
         , historySize       = 256
+        , defaultText       = []
+        , autoComplete      = Nothing
         }
 
 type ComplFunction = String -> IO [String]
@@ -142,7 +182,21 @@ type ComplFunction = String -> IO [String]
 initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction
           -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState
 initState d rw w s compl gc fonts pt h c =
-    XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c
+    XPS { dpy                = d
+        , rootw              = rw
+        , win                = w
+        , screen             = s
+        , complWin           = Nothing
+        , complWinDim        = Nothing
+        , completionFunction = compl
+        , gcon               = gc
+        , fontS              = fonts
+        , xptype             = XPT pt
+        , command            = defaultText c
+        , offset             = length (defaultText c)
+        , history            = h
+        , config             = c
+        }
 
 -- | Same as 'mkXPrompt', except that the action function can have
 --   type @String -> X a@, for any @a@, and the final action returned
@@ -237,13 +291,14 @@ completionHandle ::  [String] -> KeyStroke -> Event -> XP ()
 completionHandle c (ks,_) (KeyEvent {ev_event_type = t})
     | t == keyPress && ks == xK_Tab = do
   st <- get
+  let updateState l = do let new_command = nextCompletion (xptype st) (command st) l
+                         modify $ \s ->  s { command = new_command, offset = length new_command }
+      updateWins  l = do redrawWindows l
+                         eventLoop (completionHandle l)
   case c of
-    [] -> do updateWindows
-             eventLoop handle
-    l  -> do let new_command = newCommand (command st) l
-             modify $ \s ->  s { command = new_command, offset = length new_command }
-             redrawWindows c
-             eventLoop (completionHandle c)
+    []  -> updateWindows   >> eventLoop handle
+    [x] -> updateState [x] >> getCompletions >>= updateWins
+    l   -> updateState l   >> updateWins l
 -- key release
     | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)
 -- other keys
@@ -252,19 +307,24 @@ completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})
 -- some other event: go back to main loop
 completionHandle _ k e = handle k e
 
--- | Given a completion and a list of possible completions, returns the
--- index of the next completion in the list
-newIndex :: String -> [String] -> Int
-newIndex com cl =
-    case elemIndex (getLastWord com) cl of
-      Just i -> if i >= length cl - 1 then 0 else i + 1
-      Nothing -> 0
-
--- | Given a completion and a list of possible completions, returns the
--- the next completion in the list
-newCommand :: String -> [String] -> String
-newCommand com cl =
-    skipLastWord com ++ (cl !! (newIndex com cl))
+tryAutoComplete :: XP Bool
+tryAutoComplete = do
+    ac <- gets (autoComplete . config)
+    case ac of
+        Just d -> do cs <- getCompletions
+                     case cs of
+                         [c] -> runCompleted c d >> return True
+                         _   -> return False
+        Nothing    -> return False
+  where runCompleted cmd delay = do
+            st <- get
+            let new_command = nextCompletion (xptype st) (command st) [cmd]
+            modify $ \s -> s { command = "autocompleting..." }
+            updateWindows
+            io $ threadDelay delay
+            modify $ \s -> s { command = new_command }
+            historyPush
+            return True
 
 -- KeyPresses
 
@@ -273,7 +333,7 @@ data Direction = Prev | Next deriving (Eq,Show,Read)
 keyPressHandle :: KeyMask -> KeyStroke -> XP ()
 -- commands: ctrl + ... todo
 keyPressHandle mask (ks,_)
-    | mask == controlMask =
+    | (mask .&. controlMask) > 0 =
         -- control sequences
         case () of
           _ | ks == xK_u               -> killBefore    >> go
@@ -281,8 +341,11 @@ keyPressHandle mask (ks,_)
             | ks == xK_a               -> startOfLine   >> go
             | ks == xK_e               -> endOfLine     >> go
             | ks == xK_y               -> pasteString   >> go
+            | ks == xK_Right           -> moveWord Next >> go
+            | ks == xK_Left            -> moveWord Prev >> go
             | ks == xK_Delete          -> killWord Next >> go
             | ks == xK_BackSpace       -> killWord Prev >> go
+            | ks == xK_w               -> killWord Prev >> go
             | ks == xK_g || ks == xK_c -> quit
             | otherwise  -> eventLoop handle -- unhandled control sequence
     | ks == xK_Return    = historyPush       >> return ()
@@ -301,9 +364,10 @@ keyPressHandle mask (ks,_)
 -- insert a character
 keyPressHandle _ (_,s)
     | s == "" = eventLoop handle
-    | otherwise = do insertString s
+    | otherwise = do insertString (decodeInput s)
                      updateWindows
-                     eventLoop handle
+                     completed <- tryAutoComplete
+                     unless completed $ eventLoop handle
 
 -- KeyPress and State
 
@@ -380,6 +444,21 @@ moveCursor d =
   modify $ \s -> s { offset = o (offset s) (command s)}
   where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1)
 
+-- | move the cursor one word
+moveWord :: Direction -> XP ()
+moveWord d = do
+  c <- gets command
+  o <- gets offset
+  let (f,ss) = splitAt o c
+      lenToS = length . fst . break isSpace
+      ln p s = case p s of
+                 ' ':x -> 1 + lenToS x
+                 x     -> lenToS x
+      newoff = case d of
+                 Prev -> o - (ln reverse f )
+                 Next -> o + (ln id      ss)
+  modify $ \s -> s { offset = newoff }
+
 moveHistory :: Direction -> XP ()
 moveHistory d = do
   h <- getHistory
@@ -408,7 +487,7 @@ redrawWindows :: [String] -> XP ()
 redrawWindows c = do
   d <- gets dpy
   drawWin
-  case c  of
+  case c of
     [] -> return ()
     l  -> redrawComplWin l
   io $ sync d False
@@ -431,8 +510,8 @@ drawWin = do
       wh = widthOfScreen scr
       ht = height c
       bw = promptBorderWidth c
-  bgcolor <- io $ initColor d (bgColor c)
-  border  <- io $ initColor d (borderColor c)
+  Just bgcolor <- io $ initColor d (bgColor c)
+  Just border  <- io $ initColor d (borderColor c)
   p <- io $ createPixmap d w wh ht
                          (defaultDepthOfScreen scr)
   io $ fillDrawable d p gc border bgcolor (fi bw) wh ht
@@ -454,7 +533,7 @@ printPrompt drw = do
       ht = height c
   fsl <- io $ textWidthXMF (dpy st) fs f
   psl <- io $ textWidthXMF (dpy st) fs p
-  (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str
+  (asc,desc) <- io $ textExtentsXMF fs str
   let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc
       x = (asc + desc) `div` 2
 
@@ -471,7 +550,7 @@ printPrompt drw = do
 getCompletions :: XP [String]
 getCompletions = do
   s <- get
-  io $ (completionFunction s) (getLastWord $ command s)
+  io $ (completionFunction s) (commandToComplete (xptype s) (command s))
        `catch` \_ -> return []
 
 setComplWin :: Window -> ComplWindowDim -> XP ()
@@ -521,7 +600,7 @@ getComplWinDim compl = do
       (x,y) = case position c of
                 Top -> (0,ht)
                 Bottom -> (0, (0 + rem_height - actual_height))
-  (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl
+  (asc,desc) <- io $ textExtentsXMF fs $ head compl
   let yp = fi $ (ht + fi (asc - desc)) `div` 2
       xp = (asc + desc) `div` 2
       yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]
@@ -532,13 +611,13 @@ getComplWinDim compl = do
 drawComplWin :: Window -> [String] -> XP ()
 drawComplWin w compl = do
   st <- get
-  let c = config st
-      d = dpy st
+  let c   = config st
+      d   = dpy st
       scr = defaultScreenOfDisplay d
-      bw = promptBorderWidth c
-      gc = gcon st
-  bgcolor <- io $ initColor d (bgColor c)
-  border  <- io $ initColor d (borderColor c)
+      bw  = promptBorderWidth c
+      gc  = gcon st
+  Just bgcolor <- io $ initColor d (bgColor c)
+  Just border  <- io $ initColor d (borderColor c)
 
   (_,_,wh,ht,xx,yy) <- getComplWinDim compl
 
@@ -587,7 +666,7 @@ printComplString :: Display -> Drawable -> GC -> String -> String
                  -> Position -> Position -> String  -> XP ()
 printComplString d drw gc fc bc x y s = do
   st <- get
-  if s == getLastWord (command st)
+  if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st)
      then printStringXMF d drw (fontS st) gc
                             (fgHLight $ config st) (bgHLight $ config st) x y s
      else printStringXMF d drw (fontS st) gc fc bc x y s
@@ -613,7 +692,7 @@ getHistory = do
 readHistory :: IO ([History],Handle)
 readHistory = do
   home <- getEnv "HOME"
-  let path = home ++ "/.xmonad_history"
+  let path = home ++ "/.xmonad/history"
   f <- fileExist path
   if f then do h <- openFile path ReadMode
                str <- hGetContents h
@@ -627,7 +706,7 @@ readHistory = do
 writeHistory :: [History] -> IO ()
 writeHistory hist = do
   home <- getEnv "HOME"
-  let path = home ++ "/.xmonad_history"
+  let path = home ++ "/.xmonad/history"
   catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ())
 
 -- $xutils
@@ -665,6 +744,33 @@ mkComplFunFromList _ [] = return []
 mkComplFunFromList l s =
   return $ filter (\x -> take (length s) x == s) l
 
+-- | This function takes a list of possible completions and returns a
+-- completions function to be used with 'mkXPrompt'. If the string is
+-- null it will return all completions.
+mkComplFunFromList' :: [String] -> String -> IO [String]
+mkComplFunFromList' l [] = return l
+mkComplFunFromList' l s =
+  return $ filter (\x -> take (length s) x == s) l
+
+
+-- | Given the prompt type, the command line and the completion list,
+-- return the next completion in the list for the last word of the
+-- command line. This is the default 'nextCompletion' implementation.
+getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String
+getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni)
+    where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of
+                 Just i -> if i >= length l - 1 then 0 else i + 1
+                 Nothing -> 0
+
+-- | An alternative 'nextCompletion' implementation: given a command
+-- and a completion list, get the next completion in the list matching
+-- the whole command line.
+getNextCompletion :: String -> [String] -> String
+getNextCompletion c l = l !! idx
+    where idx = case c `elemIndex` l of
+                  Just i  -> if i >= length l - 1 then 0 else i + 1
+                  Nothing -> 0
+
 -- Lift an IO action into the XP
 io :: IO a -> XP a
 io = liftIO
@@ -699,3 +805,15 @@ breakAtSpace s
 -- | Sort a list and remove duplicates.
 uniqSort :: Ord a => [a] -> [a]
 uniqSort = toList . fromList
+
+-- | 'historyCompletion' provides a canned completion function much like
+--   getShellCompl; you pass it to mkXPrompt, and it will make completions work
+--   from the query history stored in ~/.xmonad/history.
+historyCompletion :: ComplFunction
+historyCompletion = \x -> liftM (filter $ isInfixOf x) readHistoryIO
+
+-- We need to define this locally because there is no function with the type "XP a -> IO a", and
+-- 'getHistory' is uselessly of the type "XP [String]".
+readHistoryIO :: IO [String]
+readHistoryIO = do (hist,_) <- readHistory
+                   return $ map command_history hist

XMonad/Prompt/AppLauncher.hs

@@ -0,0 +1,72 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.AppLauncher
+-- Copyright   :  (C) 2008 Luis Cabellos
+-- License     :  BSD3
+--
+-- Maintainer  :  zhen.sydow@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for launch applicationes that receive parameters in the command 
+-- line. The launcher call a prompt to get the parameters.
+--
+-----------------------------------------------------------------------------
+module XMonad.Prompt.AppLauncher ( -- * Usage
+                                    -- $usage
+                                    launchApp
+                                   
+                                  -- * Use case: launching gimp with file
+                                  -- $tip
+                                  ) where
+
+import XMonad (X(),MonadIO)
+import XMonad.Core (spawn)
+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())
+import XMonad.Prompt.Shell (getShellCompl)
+
+{- $usage
+   This module is intended to allow the launch of the same application
+   but changing the parameters using the user response. For example, when
+   you want to open a image in gimp program, you can open gimp and then use
+   the File Menu to open the image or you can use this module to select
+   the image in the command line.
+   
+   We use Prompt to get the user command line. This also allow to autoexpand
+   the names of the files when we are writing the command line.
+ -}
+
+{- $tip
+
+First, you need to import necessary modules. Prompt is used to get the promp
+configuration and the AppLauncher module itself.
+
+> import XMonad.Prompt
+> import XMonad.Prompt.AppLauncher as AL
+
+Then you can add the bindings to the applications.
+
+> ...
+> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" )
+> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" )
+> ...
+
+ -}
+
+-- A customized prompt
+data AppPrompt = AppPrompt String
+instance XPrompt AppPrompt where
+    showXPrompt (AppPrompt n) = n ++ " "
+
+type Application = String
+type Parameters = String
+
+{- | Given an application and its parameters, launch the application. -}
+launch :: MonadIO m => Application -> Parameters -> m ()
+launch app params = spawn ( app ++ " " ++ params )
+
+
+{- | Get the user's response to a prompt an launch an application using the
+   input as command parameters of the application.-}
+launchApp :: XPConfig -> Application -> X ()
+launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app

XMonad/Prompt/DirExec.hs

@@ -0,0 +1,102 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.DirExec
+-- Copyright   :  (C) 2008 Juraj Hercek
+-- License     :  BSD3
+--
+-- Maintainer  :  juhe_xmonad@hck.sk
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A directory file executables prompt for XMonad. This might be useful if you
+-- don't want to have scripts in your PATH environment variable (same
+-- executable names, different behavior) - otherwise you might want to use
+-- "XMonad.Prompt.Shell" instead - but you want to have easy access to these
+-- executables through the xmonad's prompt.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.DirExec
+    ( -- * Usage
+      -- $usage
+      dirExecPrompt
+    , dirExecPromptNamed
+    ) where
+
+import System.Directory
+import Control.Monad
+import Data.List
+import XMonad
+import XMonad.Prompt
+
+-- $usage
+-- 1. In your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Prompt.DirExec
+--
+-- 2. In your keybindings add something like:
+--
+-- >   , ("M-C-x", dirExecPrompt defaultXPConfig spawn "/home/joe/.scipts")
+--
+-- or
+--
+-- >   , ("M-C-x", dirExecPromptNamed defaultXPConfig spawn
+-- >                                  "/home/joe/.scripts" "My Scripts: ")
+--
+-- or add this after your default bindings:
+--
+-- >   ++
+-- >   [ ("M-x " ++ key, dirExecPrompt defaultXPConfig fn "/home/joe/.scripts")
+-- >     | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ]
+-- >   ]
+-- >   ++
+--
+-- The first alternative uses the last element of the directory path for
+-- a name of prompt. The second alternative uses the provided string
+-- for the name of the prompt. The third alternative defines 2 key bindings,
+-- first one spawns the program by shell, second one runs the program in
+-- terminal
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data DirExec = DirExec String
+
+instance XPrompt DirExec where
+    showXPrompt (DirExec name) = name
+
+-- | Function 'dirExecPrompt' starts the prompt with list of all executable
+-- files in directory specified by 'FilePath'. The name of the prompt is taken
+-- from the last element of the path. If you specify root directory - @\/@ - as
+-- the path, name @Root:@ will be used as the name of the prompt instead. The
+-- 'XPConfig' parameter can be used to customize visuals of the prompt.
+-- The runner parameter specifies the function used to run the program - see
+-- usage for more information
+dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X ()
+dirExecPrompt cfg runner path = do
+    let name = (++ ": ") . last
+                         . (["Root"] ++) -- handling of "/" path parameter
+                         . words
+                         . map (\x -> if x == '/' then ' ' else x)
+                         $ path
+    dirExecPromptNamed cfg runner path name
+
+-- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except
+-- the name of the prompt is specified by 'String' parameter.
+dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X ()
+dirExecPromptNamed cfg runner path name = do
+    let path' = path ++ "/"
+    cmds <- io $ getDirectoryExecutables path'
+    mkXPrompt (DirExec name) cfg (compList cmds) (runner . (path' ++))
+    where
+        compList cmds s = return . filter (isInfixOf s) $ cmds
+
+getDirectoryExecutables :: FilePath -> IO [String]
+getDirectoryExecutables path =
+    (getDirectoryContents path >>=
+        filterM (\x -> let x' = path ++ x in
+            liftM2 (&&)
+                (doesFileExist x')
+                (liftM executable (getPermissions x'))))
+    `catch` (return . return . show)
+