Bump version to 0.7

This also fixes a (minor) bug when the focussed window is present on
multiple visible workspaces.

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!)
 --

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,27 +9,67 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Provides bindings to cycle forward or backward through the list
--- of workspaces, and to move windows there, and to cycle between the screens.
+-- 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,
-                              nextScreen,
-                              prevScreen,
-                              shiftNextScreen,
-                              shiftPrevScreen
+                                -- * 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 ( findIndex )
-import Data.Maybe ( fromMaybe )
+import Data.Maybe ( isNothing, isJust )
 
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter)
@@ -39,7 +79,9 @@ import XMonad.Util.WorkspaceCompare
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.CycleWS
---
+-- >
+-- > -- a basic CycleWS setup
+-- >
 -- >   , ((modMask x,               xK_Down),  nextWS)
 -- >   , ((modMask x,               xK_Up),    prevWS)
 -- >   , ((modMask x .|. shiftMask, xK_Down),  shiftToNext)
@@ -48,34 +90,52 @@ import XMonad.Util.WorkspaceCompare
 -- >   , ((modMask x,               xK_Left),  prevScreen)
 -- >   , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen)
 -- >   , ((modMask x .|. shiftMask, xK_Left),  shiftPrevScreen)
--- >   , ((modMask x,               xK_t),     toggleWS)
+-- >   , ((modMask x,               xK_z),     toggleWS)
 --
 -- If you want to follow the moved window, you can use both actions:
 --
 -- >   , ((modMask x .|. shiftMask, xK_Down), shiftToNext >> nextWS)
 -- >   , ((modMask x .|. shiftMask, xK_Up),   shiftToPrev >> prevWS)
 --
+-- 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
 
@@ -86,12 +146,93 @@ shiftBy :: Int -> X ()
 shiftBy d = wsBy d >>= windows . shift
 
 wsBy :: Int -> X (WorkspaceId)
-wsBy d = do
-    ws <- gets windowset
-    sort' <- getSortByTag
-    let orderedWs = sort' (workspaces ws)
-    let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs
-    let next = orderedWs !! ((now + d) `mod` length orderedWs)
+wsBy = findWorkspace getSortByIndex Next AnyWS
+
+{- $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
@@ -118,6 +259,21 @@ screenBy d = do ws <- gets windowset
                 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

XMonad/Actions/DynamicWorkspaces.hs

@@ -22,12 +22,11 @@ module XMonad.Actions.DynamicWorkspaces (
                                          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 +62,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 +76,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 ()

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.Layout.WindowNavigation (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/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/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/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

@@ -7,14 +7,13 @@
  Stability   :  unstable
  Portability :  unportable
 
- A module for easily running Internet searches on web sites through XMonad.
- Modeled after the handy Surfraw CLI search tools
- <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
+ A module for easily running Internet searches on web sites through xmonad.
+ Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
 
  Additional sites welcomed.
 -}
 module XMonad.Actions.Search (      -- * Usage
-                                 -- $usage
+                                    -- $usage
                                  search,
                                  simpleEngine,
                                  promptSearch,
@@ -22,10 +21,17 @@ module XMonad.Actions.Search (      -- * Usage
 
                                  amazon,
                                  google,
+                                 hoogle,
                                  imdb,
+                                 maps,
+                                 mathworld,
+                                 scholar,
                                  wayback,
-                                 wikipedia,
-                                 hoogle
+                                 wikipedia
+
+                                    -- * Use case: searching with a submap
+                                    -- $tip
+
                           ) where
 
 import Data.Char (chr, ord, isAlpha, isMark, isDigit)
@@ -38,23 +44,88 @@ 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).
+   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.
+   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 'simpleEngine'.
+   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 'simpleEngine'.
+
+   The currently available search engines are:
+
+* 'amazon' -- Amazon keyword 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.
+
+* 'wayback' -- the Wayback Machine.
+
+* 'wikipedia' -- basic Wikipedia 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 \"firefox\" S.google)
+>       , ((0, xK_h), method \"firefox\" S.hoogle)
+>       , ((0, xK_w), method \"firefox\" 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.
@@ -88,9 +159,12 @@ escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
                    | otherwise = chr (ord 'A' + fromIntegral (d - 10))
 
 type Browser      = FilePath
+type Query        = String
 type SearchEngine = String -> String
 
-search :: MonadIO m => Browser -> SearchEngine -> String -> m ()
+{- | Given a browser, a search engine, and a search term, perform the
+     requested search in the browser. -}
+search :: MonadIO m => Browser -> SearchEngine -> Query -> m ()
 search browser site query = safeSpawn browser $ site query
 
 {- | Given a base URL, create the SearchEngine that escapes the query and
@@ -104,15 +178,18 @@ search browser site query = safeSpawn browser $ site query
    from site to site, often considerably. Generally, examining the resultant URL
    of a search will allow you to reverse-engineer it if you can't find the
    necessary URL already described in other projects such as Surfraw. -}
-simpleEngine :: String -> SearchEngine
+simpleEngine :: Query -> SearchEngine
 simpleEngine site query = site ++ escape query
 
--- The engines
-amazon, google, hoogle, imdb, wayback, wikipedia :: SearchEngine
+-- The engines.
+amazon, google, hoogle, imdb, maps, mathworld, scholar, wayback, wikipedia :: SearchEngine
 amazon    = simpleEngine "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
 google    = simpleEngine "http://www.google.com/search?num=100&q="
 hoogle    = simpleEngine "http://www.haskell.org/hoogle/?q="
 imdb      = simpleEngine "http://www.imdb.com/Find?select=all&for="
+maps      = simpleEngine "http://maps.google.com/maps?q="
+mathworld = simpleEngine "http://mathworld.wolfram.com/search/?query="
+scholar   = simpleEngine "http://scholar.google.com/scholar?q="
 wikipedia = simpleEngine "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="
 wayback   = simpleEngine "http://web.archive.org/"
 {- This doesn't seem to work, but nevertheless, it seems to be the official
@@ -122,17 +199,17 @@ wayback   = simpleEngine "http://web.archive.org/"
 {- | Like 'search', but in this case, the string is not specified but grabbed
  from the user's response to a prompt. Example:
 
- > , ((modm,               xK_g     ), promptSearch greenXPConfig "firefox" google)
+ > , ((modm, xK_g), promptSearch greenXPConfig "firefox" google)
 
 -}
 promptSearch :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearch config browser site = mkXPrompt Search config (getShellCompl []) $ search browser site
 
-{- | Like search, but for use with the X selection; it grabs the selection,
+{- | Like 'search', but for use with the X selection; it grabs the selection,
    passes it to a given searchEngine and opens it in the given browser. Example:
 
-> , ((modm .|. shiftMask, xK_g     ), selectSearch "firefox" google)
+> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google)
 
 -}
 selectSearch :: MonadIO m => Browser -> SearchEngine -> m ()
-selectSearch browser searchEngine = search browser searchEngine =<< getSelection
+selectSearch browser searchEngine = search browser searchEngine =<< getSelection

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,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+
+-- $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 (RelativePosition 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
+updatePointer :: PointerPosition -> X ()
+updatePointer p = withFocused $ \w -> do
+  dpy <- asks display
+  root <- asks theRoot
+  wa <- io $ getWindowAttributes dpy w
+  (_sameRoot,_,w',rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+  -- Can sameRoot ever be false in this case? I'm going to assume not
+  unless (w == w') $
+    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
+

XMonad/Actions/WindowGo.hs

@@ -0,0 +1,86 @@
+{- |
+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,
+                 runOrRaise,
+                 raiseMaybe,
+                 module XMonad.ManageHook
+                ) where
+
+import XMonad (Query(), X(), withWindowSet, spawn, runQuery, focus)
+import Control.Monad (filterM)
+import qualified XMonad.StackSet as W (allWindows)
+import XMonad.ManageHook
+
+{- $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"
+For detailed instructions on editing your key bindings, see
+"XMonad.Doc.Extending#Editing_key_bindings". -}
+
+-- | 'action' is an executable to be run via 'spawn' if the Window cannot be found.
+--   Presumably this executable is the same one that you were looking for.
+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 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 "XMonad.Utils.Run"'s 'runInTerm'):
+
+  > , ((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

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,33 @@ module XMonad.Config.Arossato
     ( -- * Usage
       -- $usage
       arossatoConfig
-    , arossatoTabbedConfig
     ) where
 
 import qualified Data.Map as M
+import System.IO (hPutStrLn)
 
-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.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 +55,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 +72,6 @@ import XMonad.Prompt.XMonad
 -- >     ( -- * Usage
 -- >       -- $usage
 -- >       arossatoConfig
--- >     , arossatoTabbedConfig
 -- >     ) where
 --
 -- to
@@ -70,51 +80,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 +147,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 +167,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/Dons.hs

@@ -14,11 +14,15 @@ module XMonad.Config.Dons where
 
 import XMonad
 import XMonad.Hooks.DynamicLog
+import XMonad.Layout.NoBorders
 
 donsMain :: IO ()
-donsMain = dzen $ \conf -> xmonad $ conf
-        { borderWidth        = 2
-        , terminal           = "term"
-        , normalBorderColor  = "#cccccc"
-        , focusedBorderColor = "#cd8b00" }
-
+donsMain = dzen $ \x -> xmonad $ x
+        { terminal           = "term"
+        , normalBorderColor  = "#333333"
+        , focusedBorderColor = "red"
+        , layoutHook         = smartBorders (layoutHook x)
+        , manageHook         =
+                manageHook x <+>
+                    (className =? "Toplevel" --> doFloat)
+        }

XMonad/Config/Droundy.hs

@@ -8,41 +8,42 @@
 
 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.Simplest ( Simplest(Simplest) )
+import XMonad.Layout.Square ( Square(Square) )
+import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L),
+                                        windowNavigation )
+import XMonad.Layout.NoBorders ( smartBorders )
+import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )
+import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
+import XMonad.Layout.ShowWName ( showWName )
+import XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace )
 
-import XMonad.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-*-*-*-*-*-*-*"
@@ -79,12 +80,8 @@ keys x = M.fromList $
     , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit 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)
@@ -109,15 +106,8 @@ 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 .|. controlMask .|. shiftMask, xK_space),
+       toggleScratchWorkspace (Simplest */* Simplest) )
 
     ]
  
@@ -126,19 +116,20 @@ keys x = M.fromList $
     ++
     zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
 
-config = -- withUrgencyHook FocusUrgencyHook $
-         withUrgencyHook NoUrgencyHook $
-         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 "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
-                        Named "widescreen" ((mytab *||* mytab)
+         , XMonad.workspaces = ["mutt","iceweasel"]
+         , layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $
+                        smartBorders $ windowNavigation $
+                        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.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
@@ -146,7 +137,7 @@ config = -- withUrgencyHook FocusUrgencyHook $
          , 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' 
@@ -163,10 +154,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/Sjanssen.hs

@@ -29,11 +29,11 @@ sjanssenConfig = do
                 , ((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)
+        , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme)
         , manageHook = manageHook defaultConfig <+> manageDocks
         }
  where
-    tiled   = HintedTile 1 0.03 0.5
+    tiled   = HintedTile 1 0.03 0.5 TopLeft
 
     mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
         [((modm,               xK_p     ), shellPrompt myPromptConfig)
@@ -44,7 +44,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/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>
+(Mar. 2008) tarball here:
+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.7>
 
 -}
 

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>.
 --
 -----------------------------------------------------------------------------
 
@@ -285,6 +288,10 @@ and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmon
 For more information, see the Haddock documentation:
 <http://www.haskell.org/haddock/haddock-html-0.8/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>.
+
 -}
 
 {- $license

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,20 @@ edit your key bindings.
 
 * "XMonad.Actions.MouseGestures": bind mouse gestures to actions.
 
-* "XMonad.Actions.RotSlaves": rotate non-master windows.
+* "XMonad.Actions.MouseResize": use with
+  "XMonad.Layout.WindowArranger" to resize windows with the mouse when
+  using a floating layout.
 
-* "XMonad.Actions.RotView": cycle through non-empty workspaces.
+* "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.Search": provide helpful functions for easily
   running web searchs.
@@ -167,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.
 
 -}
 
@@ -225,13 +243,19 @@ 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.
 
@@ -267,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.
@@ -291,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.
 
@@ -307,29 +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.
 
@@ -349,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
@@ -382,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;
 
@@ -423,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:
@@ -432,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.
@@ -506,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>\".
 
  -}
 
@@ -654,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
@@ -683,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
@@ -767,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
 
@@ -839,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/DynamicLog.hs

@@ -8,41 +8,48 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- DynamicLog
---
--- By default, log events in:
---
--- >     1 2 [3] 4 8
---
--- format, although the format is highly customizable.
--- Suitable to pipe into dzen or xmobar.
+-- 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
+
+    -- * Drop-in loggers
+    dzen,
     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 Data.Ord ( comparing )
 import qualified XMonad.StackSet as S
@@ -57,27 +64,81 @@ import XMonad.Hooks.UrgencyHook
 --
 -- >    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> }
+--
+-- 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:
+--
+-- > 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
+--
+-- > 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.
 --
 dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO ()
 dzen f = do
@@ -91,44 +152,68 @@ dzen f = do
     bg      = "'#3f3c6d'"
     flags   = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
 
--- |
--- An example log hook, print a status bar output to stdout, in the form:
+-- | 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.
+-- | An example log hook that emulates dwm's status bar, using colour
+-- codes printed to dzen.  Requires dzen. Workspaces, xinerama,
+-- layouts and the window title are handled.
+dynamicLogDzen :: X ()
+dynamicLogDzen = dynamicLogWithPP dzenPP
+
+-- | These are good defaults to be used with the xmobar status bar.
+dynamicLogXmobar :: X ()
+dynamicLogXmobar = dynamicLogWithPP xmobarPP
+
+-- | Format the current status using the supplied pretty-printing format,
+--   and write it to stdout.
 dynamicLogWithPP :: PP -> X ()
-dynamicLogWithPP pp = do
+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' <- getSortByTag
+    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
 
-    io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $
+    -- run extra loggers, ignoring any that generate errors.
+    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
+
+    return $ 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 :: ([WindowSpace] -> [WindowSpace]) -> [Window] -> PP -> WindowSet -> String
+-- | 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))
@@ -147,8 +232,12 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
 -- > [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
 
@@ -159,23 +248,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()")
@@ -186,23 +290,73 @@ 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
+-- ??? 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
-             , ppSep, ppWsSep :: 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 "<" ">"
@@ -215,9 +369,11 @@ defaultPP = PP { ppCurrent         = wrap "[" "]"
                , 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
@@ -236,17 +392,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
                        }
 
--- | 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,12 +9,14 @@
 -- 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
+    ewmhDesktopsLogHook,
+    ewmhDesktopsLayout
     ) where
 
 import Data.List
@@ -26,6 +28,7 @@ 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@:
@@ -37,18 +40,24 @@ import XMonad.Util.WorkspaceCompare
 -- > myLogHook = do ewmhDesktopsLogHook
 -- >                return ()
 -- >
--- > main = xmonad defaultConfig { logHook = myLogHook }
--- 
+-- > layoutHook = ewmhDesktopsLayout $ avoidStruts $ simpleTabbed ||| Full ||| etc..
+-- >
+-- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook }
+--
 -- 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
-    sort' <- getSortByTag
+    sort' <- getSortByIndex
     let ws = sort' $ W.workspaces s
     let wins = W.allWindows s
 
@@ -62,7 +71,7 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
 
     -- Current desktop
     let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws
-    
+
     setCurrentDesktop curr
 
     setClientList wins
@@ -70,11 +79,11 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
     -- Per window Desktop
     -- To make gnome-panel accept our xinerama stuff, we display
     -- all visible windows on the current desktop.
-    forM_ (W.current s : W.visible s) $ \x -> 
+    forM_ (W.current s : W.visible s) $ \x ->
         forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
             setWindowDesktop win curr
 
-    forM_ (W.hidden s) $ \w -> 
+    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
@@ -83,6 +92,51 @@ ewmhDesktopsLogHook = withWindowSet $ \s -> do
 
     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)
+--
+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"
+       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 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
@@ -132,6 +186,7 @@ setSupported = withDisplay $ \dpy -> do
     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"

XMonad/Hooks/ManageDocks.hs

@@ -24,8 +24,8 @@ module XMonad.Hooks.ManageDocks (
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
--- import Data.Maybe (catMaybes, fromMaybe)
 import Control.Monad
+import XMonad.Layout.LayoutModifier
 
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -49,6 +49,13 @@ import Control.Monad
 --
 -- > ,((modMask x, xK_b     ), sendMessage ToggleStruts)
 --
+-- /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".
 
@@ -111,43 +118,57 @@ calcGap = withDisplay $ \dpy -> do
     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
 
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
-
-r2c :: Rectangle -> RectC
-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w, fi y + fi h)
-
-c2r :: RectC -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1) (fi $ y2 - y1)
-
 -- | Adjust layout automagically.
-avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a
-avoidStruts = AvoidStruts True
+avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
+avoidStruts = ModifiedLayout (AvoidStruts True)
 
-data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show )
+data AvoidStruts a = AvoidStruts Bool 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 ($ 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
+instance LayoutModifier AvoidStruts a where
+    modifyLayout (AvoidStruts b) w r = do
+        nr <- if b then fmap ($ r) calcGap else return r
+        runLayout w nr
+
+    handleMess (AvoidStruts b ) m
+        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b)
+        | otherwise = return Nothing
 
 data Side = L | R | T | B
 
+-- | (Side, height\/width, initial pixel, final pixel).
+
 type Strut = (Side, 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
+
+-- | Invertible conversion.
+
+r2c :: Rectangle -> RectC
+r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
+
+-- | Invertible conversion.
+
+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       )
@@ -158,5 +179,16 @@ reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
  where
     mx a b = max a (b + n)
     mn a b = min a (b - n)
-    inRange (a, b) c = c > a && c < b
-    p (a, b) = inRange (a, b) l || inRange (a, b) h || inRange (a, b) l || inRange (l, h) b
+    p r = r `overlaps` (l, h)
+
+-- | 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@.
+
+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

@@ -31,7 +31,9 @@ module XMonad.Hooks.ManageHelpers (
     maybeToDefinite,
     MaybeManageHook,
     transience,
-    transience'
+    transience',
+    doRectFloat,
+    doCenterFloat
 ) where
 
 import XMonad
@@ -42,9 +44,9 @@ 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
+-- | 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
@@ -68,12 +70,14 @@ 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'
+    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'
+    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
@@ -85,13 +89,15 @@ p -?> f = do
 
 -- | 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
+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
+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
@@ -107,19 +113,18 @@ isKDETrayWindow = ask >>= \w -> liftX $ do
 -- 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
+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 it's parent.
+-- is transient, and then move it to its parent.
 transience :: MaybeManageHook
-transience = transientTo </=? Nothing 
-             -?>> move
-                 where move :: Maybe Window -> ManageHook
-                       move mw = maybe idHook (doF . move') mw
-                                 where move' :: Window -> (WindowSet -> WindowSet)
-                                       move' w = \s -> maybe s (`W.shift` s) (W.findTag w s)
+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
@@ -128,3 +133,16 @@ 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 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/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

@@ -23,7 +23,7 @@
 -- need to do it once per XMonad execution)
 --
 -- 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

XMonad/Layout/Combo.hs

@@ -6,7 +6,7 @@
 -- Module      :  XMonad.Layout.Combo
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD-style (see LICENSE)
--- 
+--
 -- Maintainer  :  David Roundy <droundy@darcs.net>
 -- 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 :: Maybe Event = 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
+    , w `elem`             (map (fst . fst) dwrs) = updateDecos sh t fs dwrs
+    | ExposeEvent   {ev_window = w} <- e
+    , w `elem` (catMaybes $ map (fst . snd) dwrs) = updateDecos sh t fs dwrs
+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/DwmStyle.hs

@@ -0,0 +1,68 @@
+{-# 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)
+
+-- | 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/Grid.hs

@@ -17,7 +17,7 @@
 module XMonad.Layout.Grid (
     -- * Usage
     -- $usage
-        Grid(..)
+        Grid(..), arrange
 ) where
 
 import XMonad

XMonad/Layout/HintedTile.hs

@@ -16,9 +16,10 @@
 -----------------------------------------------------------------------------
 
 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
@@ -32,7 +33,7 @@ import Control.Monad
 --
 -- Then edit your @layoutHook@ by adding the HintedTile layout:
 --
--- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc..
+-- > myLayouts = HintedTile 1 0.1 0.5 TopLeft Tall ||| Full ||| etc..
 -- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
 -- For more detailed instructions on editing the layoutHook see:
@@ -42,21 +43,26 @@ import Control.Monad
 data HintedTile a = HintedTile
     { nmaster     :: Int
     , delta, frac :: Rational
+    , alignment   :: Alignment
     , orientation :: Orientation
     } deriving ( Show, Read )
 
-data Orientation = Wide | Tall deriving ( Show, Read )
+data Orientation = Wide | Tall
+    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
+    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do
         bhs <- mapM getHints 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)
@@ -79,15 +85,25 @@ getHints w = withDisplay $ \d -> io $ liftM2 (,)
     (fromIntegral . wa_border_width <$> getWindowAttributes d w)
     (getWMNormalHints d w)
 
--- 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)))
+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 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 the screen vertically (horizontally) into n subrectangles
+divide :: Alignment -> Orientation -> [(Dimension, SizeHints)] -> 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) = hintsUnderBorder bh (sw, 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, 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) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh)
 

XMonad/Layout/IM.hs

@@ -0,0 +1,86 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.IM
+-- Copyright   :  (c) Roman Cheplyaka
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Layout suitable for workspace with multi-windowed instant messanger (like
+-- Psi or Tkabber).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.IM (
+    -- * Usage
+    -- $usage
+
+    -- * Hints
+    -- $hints
+
+    -- * TODO
+    -- $todo
+        Property(..), IM(..)
+) where
+
+import XMonad
+import qualified XMonad.StackSet as S
+import Data.List
+import XMonad.Layout (splitHorizontallyBy)
+import XMonad.Layout.Grid (arrange)
+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 the IM layout:
+--
+-- > myLayouts = IM (1%7) (ClassName "Tkabber") ||| 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".
+
+-- $todo
+-- All these items are questionable. Please let me know if you find them useful.
+--
+-- * shrink\/expand
+--
+-- * allow roster placement on the right side or even on top\/bottom
+--
+-- * use arbitrary layout instead of grid
+
+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)
+
+-- | 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 }

XMonad/Layout/LayoutCombinators.hs

@@ -10,42 +10,50 @@
 -- 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

@@ -13,14 +13,16 @@
 -- 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@:
@@ -49,13 +51,13 @@ data LayoutHints a = LayoutHints deriving (Read, Show)
 
 instance LayoutModifier LayoutHints Window where
     modifierDescription _ = "Hinted"
-    redoLayout _ _ _ xs = do
+    redoLayout _ _ s xs = do
                             bW <- asks (borderWidth . config)
                             xs' <- mapM (applyHint bW) xs
                             return (xs', Nothing)
      where
-        applyHint bW (w,Rectangle a b c d) =
+        applyHint bW (w,r@(Rectangle a b c d)) =
             withDisplay $ \disp -> do
-                sh <- io $ getWMNormalHints disp w
+                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')
+                return (w, if isInStack s w then Rectangle a b c' d' else r)

XMonad/Layout/LayoutModifier.hs

@@ -11,54 +11,259 @@
 -- 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

@@ -58,7 +58,7 @@ 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

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,7 @@ module XMonad.Layout.Magnifier
       -- $usage
       magnifier,
       magnifier',
+      magnifierOff,
       magnifiercz,
       magnifiercz',
       MagnifyMsg (..)
@@ -45,14 +46,10 @@ import XMonad.Layout.LayoutModifier
 -- By default magnifier increases the focused window's size by 1.5.
 -- You can also use:
 --
--- > magnifiercz (12%10)
+-- > magnifiercz 1.2
 --
 -- to use a custom level of magnification.  You can even make the focused
--- window smaller for a pop in effect. Keep in mind, you must
---
--- > import Data.Ratio
---
--- in order to use rationals (such as @12%10@) in your config.
+-- window smaller for a pop in effect.
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
@@ -65,6 +62,18 @@ 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".
@@ -82,12 +91,16 @@ magnifiercz cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On All)
 magnifier' :: l a -> ModifiedLayout Magnifier l a
 magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)
 
+-- | Magnifier that defaults to Off
+magnifierOff :: l a -> ModifiedLayout Magnifier l a
+magnifierOff = ModifiedLayout (Mag 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)*1.0::Double) On NoMaster)
 
-data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable )
+data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )
 instance Message MagnifyMsg
 
 data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show)
@@ -106,9 +119,11 @@ instance LayoutModifier Magnifier Window where
     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 ToggleOff   <- fromMessage m = return . Just $ (Mag (z      ) Off t)
+                    | Just Toggle      <- fromMessage m = return . Just $ (Mag (z      ) Off t)
     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"
@@ -123,7 +138,7 @@ unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
 
 applyMagnifier :: 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)
 
@@ -134,9 +149,12 @@ magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h'
           w' = round $ fromIntegral w * zoom
           h' = round $ fromIntegral h * zoom
 
-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/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

@@ -29,6 +29,8 @@ module XMonad.Layout.MultiToggle (
 
 import XMonad
 
+import XMonad.StackSet (Workspace(..))
+
 import Control.Arrow
 import Data.Typeable
 import Data.Maybe
@@ -196,9 +198,11 @@ 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 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/Named.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -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

@@ -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 []
 
@@ -72,25 +76,33 @@ 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 [])
+        wset <- gets windowset
+        let
+            screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset
+            ws = tiled ++ floating
+            tiled = case 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,23 +10,14 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Configure layouts on a per-workspace basis.  NOTE that this module
--- does not (yet) work in conjunction with multiple screens! =(
---
--- Note also that when using PerWorkspace, on initial startup workspaces
--- may not respond to messages properly until a window has been opened.
--- This is due to a limitation inherent in the way PerWorkspace is
--- implemented: it cannot decide which layout to use until actually
--- required to lay out some windows (which does not happen until a window
--- is opened).
+-- Configure layouts on a per-workspace basis.
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.PerWorkspace (
-                                    -- * Usage
-                                    -- $usage
-
-                                    onWorkspace, onWorkspaces
-                                  ) where
+module XMonad.Layout.PerWorkspace
+    ( -- * Usage
+      -- $usage
+      onWorkspace, onWorkspaces
+    ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
@@ -52,9 +43,6 @@ import Data.Maybe (fromMaybe)
 -- 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
@@ -64,7 +52,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 l1 l2 = PerWorkspace [wsId] False l1 l2
 
 -- | Specify one layout to use on a particular set of workspaces, and
 --   another to use on all other workspaces.
@@ -73,73 +61,39 @@ 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
 
 -- | 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'
-
--- | 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
+mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' =
+    (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf'

XMonad/Layout/Reflect.hs

@@ -28,9 +28,9 @@ module XMonad.Layout.Reflect (
 
 import XMonad.Core
 import Graphics.X11 (Rectangle(..), Window)
-import Control.Arrow ((***), second)
-import Control.Applicative ((<$>))
+import Control.Arrow (second)
 
+import XMonad.Layout.LayoutModifier
 import XMonad.Layout.MultiToggle
 
 -- $usage
@@ -56,8 +56,8 @@ 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 (REFLECTX ?? EOT) $
--- >              mkToggle (REFLECTY ?? EOT) $
+-- > layoutHook = mkToggle (single REFLECTX) $
+-- >              mkToggle (single REFLECTY) $
 -- >                (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use
 --
 -- Finally, add some keybindings to do the toggling, for example:
@@ -68,13 +68,13 @@ import XMonad.Layout.MultiToggle
 
 -- | Apply a horizontal reflection (left \<--\> right) to a
 --   layout.
-reflectHoriz :: (LayoutClass l a) => (l a) -> Reflect l a
-reflectHoriz = Reflect Horiz
+reflectHoriz :: l a -> ModifiedLayout Reflect l a
+reflectHoriz = ModifiedLayout (Reflect Horiz)
 
 -- | Apply a vertical reflection (top \<--\> bottom) to a
 --   layout.
-reflectVert :: (LayoutClass l a) => (l a) -> Reflect l a
-reflectVert = Reflect Vert
+reflectVert :: l a -> ModifiedLayout Reflect l a
+reflectVert = ModifiedLayout (Reflect Vert)
 
 data ReflectDir = Horiz | Vert
   deriving (Read, Show)
@@ -92,18 +92,14 @@ fi :: (Integral a, Num b) => a -> b
 fi = fromIntegral
 
 
-data Reflect l a = Reflect ReflectDir (l a) deriving (Show, Read)
+data Reflect a = Reflect ReflectDir deriving (Show, Read)
 
-instance LayoutClass l a => LayoutClass (Reflect l) a where
+instance LayoutModifier Reflect a where
 
-    -- do layout l, then reflect all the generated Rectangles.
-    doLayout (Reflect d l) r s = (map (second (reflectRect d r)) *** fmap (Reflect d))
-                                 <$> doLayout l r s
+    -- reflect all the generated Rectangles.
+    pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d)
 
-    -- pass messages on to the underlying layout
-    handleMessage (Reflect d l) = fmap (fmap (Reflect d)) . handleMessage l
-
-    description (Reflect d l) = "Reflect" ++ xy ++ " " ++ description l
+    modifierDescription (Reflect d) = "Reflect" ++ xy
       where xy = case d of { Horiz -> "X" ; Vert -> "Y" }
 
 

XMonad/Layout/ResizableTile.hs

@@ -21,7 +21,7 @@ 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

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

@@ -0,0 +1,95 @@
+{-# OPTIONS -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ScratchWorkspace
+-- Copyright   :  (c) Braden Shepherdson, David Roundy 2008
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  Braden.Shepherdson@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+
+module XMonad.Layout.ScratchWorkspace ( toggleScratchWorkspace ) where
+
+import Data.List ( partition )
+import Control.Monad ( guard )
+
+import XMonad
+import XMonad.Core
+import qualified XMonad.StackSet as W
+
+hiddenRect :: Rectangle
+hiddenRect = Rectangle (-1) (-1) 0 0
+
+scratchName :: String
+scratchName = "*scratch*"
+
+-- This module uses an ugly hack, which is to create a special screen for
+-- the scratch workspace.  This screen is then moved onto a visible area or
+-- away when you ask for the scratch workspace to be shown or hidden.
+
+-- This is a workaround for the fact that we don't have anything like
+-- proper support for hierarchical workspaces, so I use the only hierarchy
+-- we've got, which is at the screen level.
+
+toggleScratchWorkspace :: LayoutClass l Int => l Int -> X ()
+toggleScratchWorkspace l =
+    do s <- gets windowset
+       defaultl <- asks (layoutHook . config)
+       srs <- withDisplay getCleanedScreenInfo
+       if length srs == 1 + length (W.visible s)
+         then -- we don't yet have a scratch screen!
+             if scratchName `W.tagMember` s
+             then return () -- We'll just bail out of scratchName already exists...
+             else do let scratchscreen = W.Screen scratch (-1) (SD hiddenRect (0,0,0,0))
+                         scratch = W.Workspace scratchName defaultl Nothing
+                         s' = s { W.visible = scratchscreen: W.visible s }
+                     modify $ \st -> st { windowset = s' }
+                     refresh
+         else -- We've already got a scratch (we think)
+           if length srs /= length (W.visible s)
+           then -- Something is odd... too many screens are visible! Do nothing.
+                return ()
+           else -- Yes, it does seem there's a scratch screen already
+              case partition ((/= -1) . W.screen) $ W.current s : W.visible s of
+              (others@(c:vs),[scratchscreen]) ->
+                  if screenRect (W.screenDetail scratchscreen) == hiddenRect
+                  then -- we're hidden now, so let's display ourselves
+                      do let r = screenRect $ W.screenDetail c
+                         (rs,_) <- runLayout (W.Workspace "" l (Just $ W.Stack 0 [1] [])) r
+                         let (r0, r1) = case rs of
+                                        [(0,ra),(1,rb)] -> (ra,rb)
+                                        [(1,ra),(0,rb)] -> (rb,ra)
+                                        [(1,ra)] -> (r,ra)
+                                        [(0,ra)] -> (ra,r)
+                                        _ -> (r,r)
+                             s' = s { W.current = setrect r0 scratchscreen,
+                                      W.visible = setrect r1 c : vs }
+                         modify $ \st -> st { windowset = s' }
+                         refresh
+                  else -- we're visible, so now we want to hide
+                       do ml <- handleMessage (W.layout $ W.workspace scratchscreen) (SomeMessage Hide)
+                          let scratchscreen' = case ml of
+                                               Nothing -> scratchscreen
+                                               Just l' -> scratchscreen
+                                                          { W.workspace =
+                                                            (W.workspace scratchscreen) { W.layout = l' } }
+                          mapM_ hide $ W.integrate' $ W.stack $ W.workspace scratchscreen
+                          let modscr scr = do guard $ scratchName /= W.tag (W.workspace scr)
+                                              r' <- pickRect (W.screen scr) srs
+                                              Just $ setrect r' scr
+                              pickRect _ [z] = Just z
+                              pickRect i (z:zs) | i < 1 = Just z
+                                                | otherwise = pickRect (i-1) zs
+                              pickRect _ [] = Nothing
+                          case mapM modscr others of
+                            Just (c':vs') ->
+                                do let s' = s { W.current = c',
+                                                W.visible = setrect hiddenRect scratchscreen' : vs' }
+                                   modify $ \st -> st { windowset = s' }
+                                   refresh
+                            _ -> return () -- weird error!
+              _ -> -- Something is odd... there doesn't seem to *really* be a scratch screen...
+                   return ()
+    where setrect :: Rectangle -> W.Screen i l a sid ScreenDetail -> W.Screen i l a sid ScreenDetail
+          setrect x scr = scr {W.screenDetail = (W.screenDetail scr) {screenRect = x}}

XMonad/Layout/ShowWName.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, TypeSynonymInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.ShowWName
@@ -67,10 +67,10 @@ defaultSWNConfig =
          , swn_fade    = 1
          }
 
-instance LayoutModifier ShowWName Window where
-    redoLayout (SWN True  c (Just (_,w))) r _ wrs = deleteWindow w >> flashName c r wrs
-    redoLayout (SWN True  c  Nothing    ) r _ wrs = flashName c r wrs
-    redoLayout (SWN False _  _          ) _ _ wrs = return (wrs, Nothing)
+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)
@@ -81,13 +81,18 @@ instance LayoutModifier ShowWName Window where
         | 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
+  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
@@ -98,7 +103,3 @@ flashName c (Rectangle _ _ wh ht) wrs = do
   io $ sync d False
   i <- startTimer (swn_fade c)
   return (wrs, Just $ SWN False c $ Just (i,w))
-
--- | Short-hand for 'fromIntegral'
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral

XMonad/Layout/SimpleDecoration.hs

@@ -0,0 +1,72 @@
+{-# 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.
+-----------------------------------------------------------------------------
+
+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,79 @@
+{-# 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
+    doLayout (SF i) sc (S.Stack w l r) = do wrs <- mapM (getSize i sc) (w : reverse l ++ r)
+                                            return (wrs, Nothing)
+    description _ = "Float"
+
+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/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/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,27 +14,25 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.Tabbed (
-                             -- * Usage:
-                             -- $usage
-                             tabbed
-                            , shrinkText, CustomShrink(CustomShrink)
-                            , TConf (..), defaultTConf
-                            , Shrinker(..)
-                            ) where
+module XMonad.Layout.Tabbed
+    ( -- * Usage:
+      -- $usage
+      simpleTabbed, tabbed, addTabs
+    , simpleTabbedBottom, tabbedBottom, addTabsBottom
+    , 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 XMonad.Hooks.UrgencyHook
+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@:
@@ -42,7 +41,14 @@ import XMonad.Hooks.UrgencyHook
 --
 -- 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 }
 --
 -- For more detailed instructions on editing the layoutHook see:
@@ -51,190 +57,66 @@ import XMonad.Hooks.UrgencyHook
 --
 -- 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
+-- | A tabbed layout with the default xmonad Theme. Here's a screen
+-- shot:
+--
+-- <http://code.haskell.org/~arossato/xmonadShots/simpleTabbed.png>
+--
+-- 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 = decoration shrinkText defaultTheme Tabbed Simplest
 
-data TConf =
-    TConf { activeColor         :: String
-          , inactiveColor       :: String
-          , urgentColor         :: String
-          , activeBorderColor   :: String
-          , inactiveBorderColor :: String
-          , urgentBorderColor   :: String
-          , activeTextColor     :: String
-          , inactiveTextColor   :: String
-          , urgentTextColor     :: String
-          , fontName            :: String
-          , tabSize             :: Int
-          } deriving (Show, Read)
+-- | A bottom-tabbed layout with the default xmonad Theme.
+simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window
+simpleTabbedBottom = decoration shrinkText defaultTheme TabbedBottom Simplest
 
-defaultTConf :: TConf
-defaultTConf =
-    TConf { activeColor         = "#999999"
-          , inactiveColor       = "#666666"
-          , urgentColor         = "#FFFF00"
-          , activeBorderColor   = "#FFFFFF"
-          , inactiveBorderColor = "#BBBBBB"
-          , urgentBorderColor   = "##00FF00"
-          , activeTextColor     = "#FFFFFF"
-          , inactiveTextColor   = "#BFBFBF"
-          , urgentTextColor     = "#FF0000"
-          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-          , tabSize             = 20
-          }
+-- | A layout decorated with tabs and the possibility to set a custom
+-- shrinker and a custom theme.
+tabbed :: (Eq a, Shrinker s) => s -> Theme
+       -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbed s c = decoration s c Tabbed Simplest
 
-data TabState =
-    TabState { tabsWindows :: [(Window,Window)]
-             , scr         :: Rectangle
-             , font        :: XMonadFont
-             }
+-- | A layout decorated with tabs at the bottom and the possibility to set a custom
+-- shrinker and a custom theme.
+tabbedBottom :: (Eq a, Shrinker s) => s -> Theme
+       -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a
+tabbedBottom s c = decoration s c TabbedBottom Simplest
 
-data Tabbed s a =
-    Tabbed (Invisible Maybe TabState) s TConf
-    deriving (Show, Read)
+addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+        -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabs s c l = decoration s c Tabbed l
 
-instance Shrinker s => LayoutClass (Tabbed s) Window where
-    doLayout (Tabbed ist ishr conf) = doLay ist ishr conf
-    handleMessage                   = handleMess
-    description _                   = "Tabbed"
+addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a
+        -> ModifiedLayout (Decoration TabbedDecoration s) l a
+addTabsBottom s c l = decoration s c TabbedBottom l
 
-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))
+data TabbedDecoration a = Tabbed | TabbedBottom deriving (Read, Show)
 
-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
-
-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)
-
-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)
-
--- 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 ()
-
-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
-
-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) True
-  io $ restackWindows d $ w : [ow]
-  ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows
-  return (w:ws)
-
-updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X ()
-updateTab ishr c fs wh (tabw,ow) = do
-  nw <- getName ow
-  ur <- readUrgents
-  let ht                   = fromIntegral $ tabSize c :: Dimension
-      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 ow
-                           (inactiveColor c, inactiveBorderColor c, inactiveTextColor c)
-                           (activeColor   c, activeBorderColor   c, activeTextColor   c)
-                           (urgentColor   c, urgentBorderColor   c, urgentTextColor   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
-
-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
-
-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
+instance Eq a => DecorationStyle TabbedDecoration a where
+    describeDeco Tabbed = "Tabbed"
+    describeDeco TabbedBottom = "Tabbed Bottom"
+    decorationMouseDragHook _ _ _ = return ()
+    pureDecoration ds _ ht _ s wrs (w,r@(Rectangle x y wh hh)) =
+            if length ws <= 1
+                then Nothing
+                else Just $ case ds of
+                    Tabbed -> Rectangle nx y wid (fi ht)
+                    TabbedBottom -> Rectangle nx (y+fi(hh-ht)) wid (fi ht)
+        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
+    shrink ds (Rectangle _ _ _ dh) (Rectangle x y w h) = case ds of
+        Tabbed -> Rectangle x (y + fi dh) w (h - dh)
+        TabbedBottom -> Rectangle x y w (h - dh)

XMonad/Layout/ThreeColumns.hs

@@ -34,11 +34,9 @@ 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"

XMonad/Layout/ToggleLayouts.hs

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

@@ -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,206 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, 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

@@ -67,7 +67,7 @@ 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 )
+data Direction = U | D | R | L deriving ( Read, Show, Eq, Ord, Enum, Bounded )
 instance Message Navigate
 
 data WNConfig =
@@ -105,7 +105,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,21 +118,23 @@ 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 $ sortby d $ filter (inr d pt . snd) 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 $ sortby d $ filter (inr d pt . snd) 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 =

XMonad/Layout/WorkspaceDir.hs

@@ -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,37 @@
 --
 -----------------------------------------------------------------------------
 
-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
+    ) where
 
 import XMonad  hiding (config, io)
 import qualified XMonad.StackSet as W
@@ -105,7 +109,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,
@@ -118,8 +125,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)
@@ -253,13 +285,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
@@ -268,20 +301,6 @@ 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))
-
 -- KeyPresses
 
 data Direction = Prev | Next deriving (Eq,Show,Read)
@@ -319,7 +338,7 @@ keyPressHandle mask (ks,_)
 -- insert a character
 keyPressHandle _ (_,s)
     | s == "" = eventLoop handle
-    | otherwise = do insertString s
+    | otherwise = do insertString (decodeInput s)
                      updateWindows
                      eventLoop handle
 
@@ -410,7 +429,7 @@ moveWord d = do
                  x     -> lenToS x
       newoff = case d of
                  Prev -> o - (ln reverse f )
-                 _    -> o + (ln id      ss)
+                 Next -> o + (ln id      ss)
   modify $ \s -> s { offset = newoff }
 
 moveHistory :: Direction -> XP ()
@@ -441,7 +460,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
@@ -464,8 +483,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
@@ -487,7 +506,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 fs str
+  (asc,desc) <- io $ textExtentsXMF fs str
   let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc
       x = (asc + desc) `div` 2
 
@@ -504,7 +523,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 ()
@@ -554,7 +573,7 @@ getComplWinDim compl = do
       (x,y) = case position c of
                 Top -> (0,ht)
                 Bottom -> (0, (0 + rem_height - actual_height))
-  (_,asc,desc,_) <- io $ textExtentsXMF 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)..]
@@ -565,13 +584,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
 
@@ -620,7 +639,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
@@ -698,6 +717,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

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)
+

XMonad/Prompt/Man.hs

@@ -58,7 +58,7 @@ instance XPrompt Man where
 manPrompt :: XPConfig -> X ()
 manPrompt c = do
   mans <- io getMans
-  mkXPrompt Man c (manCompl mans) $ runInTerm . (++) "man "
+  mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man "
 
 getMans :: IO [String]
 getMans = do

XMonad/Prompt/RunOrRaise.hs

@@ -0,0 +1,77 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.RunOrRaise
+-- Copyright   :  (C) 2008 Justin Bogner
+-- License     :  BSD3
+--
+-- Maintainer  :  mail@justinbogner.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A prompt for XMonad which will run a program, open a file,
+-- or raise an already running program, depending on context.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.RunOrRaise
+    ( -- * Usage
+      -- $usage
+      runOrRaisePrompt
+    ) where
+
+import XMonad hiding (config)
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+import XMonad.Actions.WindowGo (runOrRaise)
+import XMonad.Util.Run (runProcessWithInput)
+
+import Control.Monad (liftM2)
+import Data.Maybe
+import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions)
+
+-- $usage
+-- 1. In your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.RunOrRaise
+--
+-- 2. In your keybindings add something like:
+--
+-- >   , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig)
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data RunOrRaisePrompt = RRP
+instance XPrompt RunOrRaisePrompt where
+    showXPrompt RRP = "Run or Raise: "
+
+runOrRaisePrompt :: XPConfig -> X ()
+runOrRaisePrompt c = do cmds <- io $ getCommands
+                        mkXPrompt RRP c (getShellCompl cmds) open
+open :: String -> X ()
+open path = (io $ isNormalFile path) >>= \b ->
+            if b
+            then spawn $ "xdg-open \"" ++ path ++ "\""
+            else uncurry runOrRaise . getTarget $ path
+    where
+      isNormalFile f = exists f >>= \e -> if e then (notExecutable f) else return False
+      exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f]
+      notExecutable = fmap (not . executable) . getPermissions
+      getTarget x = (x,isApp x)
+
+isApp :: String -> Query Bool
+isApp "firefox" = className =? "Firefox-bin"
+isApp "thunderbird" = className =? "Thunderbird-bin"
+isApp x = liftM2 (==) pid $ pidof x
+
+pidof :: String -> Query Int
+pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return $ 0)
+
+pid :: Query Int
+pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)
+    where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $
+                       getWindowProperty32 d a w >>= return . getPID'
+          getPID' (Just (x:_)) = fromIntegral x
+          getPID' (Just [])     = -1
+          getPID' (Nothing)     = -1

XMonad/Prompt/Shell.hs

@@ -12,21 +12,23 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Prompt.Shell(
-                             -- * Usage
-                             -- $usage
-                             shellPrompt
-                             , getShellCompl
-                             , split
-                             , prompt
-                             , safePrompt
-                              ) where
+module XMonad.Prompt.Shell
+    ( -- * Usage
+      -- $usage
+      shellPrompt
+    , getCommands
+    , getShellCompl
+    , split
+    , prompt
+    , safePrompt
+    ) where
 
 import System.Environment
 import Control.Monad
 import Data.List
 import System.Directory
 import System.IO
+import System.Posix.Files
 import XMonad.Util.Run
 import XMonad hiding (config)
 import XMonad.Prompt
@@ -47,12 +49,13 @@ import XMonad.Prompt
 data Shell = Shell
 
 instance XPrompt Shell where
-    showXPrompt Shell = "Run: "
+    showXPrompt Shell     = "Run: "
+    completionToCommand _ = escape
 
 shellPrompt :: XPConfig -> X ()
 shellPrompt c = do
     cmds <- io $ getCommands
-    mkXPrompt Shell c (getShellCompl cmds) spawn
+    mkXPrompt Shell c (getShellCompl cmds) (spawn . encodeOutput)
 
 -- | See safe and unsafeSpawn. prompt is an alias for safePrompt;
 -- safePrompt and unsafePrompt work on the same principles, but will use
@@ -71,15 +74,20 @@ shellPrompt c = do
 prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()
 prompt = unsafePrompt
 safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
-    where run = safeSpawn c
+    where run = safeSpawn c . encodeOutput
 unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
-    where run a = unsafeSpawn $ c ++ " " ++ a
+    where run a = unsafeSpawn $ c ++ " " ++ encodeOutput a
 
 getShellCompl :: [String] -> String -> IO [String]
 getShellCompl cmds s | s == "" || last s == ' ' = return []
                      | otherwise                = do
-    f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n")
-    return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s
+    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ encodeOutput s ++ "\n")
+    files <- case f of
+               [x] -> do fs <- getFileStatus x
+                         if isDirectory fs then return [x ++ "/"]
+                                           else return [x]
+               _   -> return f
+    return . map decodeInput . uniqSort $ files ++ commandCompletionFunction cmds s
 
 commandCompletionFunction :: [String] -> String -> [String]
 commandCompletionFunction cmds str | '/' `elem` str = []

XMonad/Prompt/Ssh.hs

@@ -12,11 +12,11 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Prompt.Ssh(
-                             -- * Usage
-                             -- $usage
-                             sshPrompt
-                              ) where
+module XMonad.Prompt.Ssh
+    ( -- * Usage
+      -- $usage
+      sshPrompt
+    ) where
 
 import XMonad
 import XMonad.Util.Run
@@ -48,7 +48,9 @@ import Data.Maybe
 data Ssh = Ssh
 
 instance XPrompt Ssh where
-    showXPrompt Ssh = "SSH to: "
+    showXPrompt       Ssh = "SSH to: "
+    commandToComplete _ c = c
+    nextCompletion      _ = getNextCompletion
 
 sshPrompt :: XPConfig -> X ()
 sshPrompt c = do
@@ -56,7 +58,7 @@ sshPrompt c = do
   mkXPrompt Ssh c (mkComplFunFromList sc) ssh
 
 ssh :: String -> X ()
-ssh s = runInTerm ("ssh " ++ s)
+ssh s = runInTerm "" ("ssh " ++ s)
 
 sshComplList :: IO [String]
 sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal
@@ -88,7 +90,7 @@ sshComplListFile kh = do
 sshComplListFile' :: String -> IO [String]
 sshComplListFile' kh = do
   l <- readFile kh
-  return $ map (takeWhile (/= ',') . concat . take 1 . words)
+  return $ map (getWithPort . takeWhile (/= ',') . concat . take 1 . words)
          $ filter nonComment
          $ lines l
 
@@ -103,3 +105,11 @@ nonComment []      = False
 nonComment ('#':_) = False
 nonComment ('|':_) = False -- hashed, undecodeable
 nonComment _       = True
+
+getWithPort :: String -> String
+getWithPort ('[':str) = host ++ " -p " ++ port
+    where (host,p) = break (==']') str
+          port = case p of
+                   ']':':':x -> x
+                   _         -> "22"
+getWithPort  str = str

XMonad/Prompt/Theme.hs

@@ -0,0 +1,55 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Prompt.Theme
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A prompt for changing the theme of the current workspace
+-----------------------------------------------------------------------------
+
+module XMonad.Prompt.Theme
+    ( -- * Usage
+      -- $usage
+      themePrompt,
+    ) where
+
+import Control.Arrow ( (&&&) )
+import qualified Data.Map as M
+import Data.Maybe ( fromMaybe )
+import Data.List
+import XMonad
+import XMonad.Prompt
+import XMonad.Layout.Decoration
+import XMonad.Util.Themes
+
+-- $usage
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.Theme
+--
+-- in your keybindings add:
+--
+-- >   , ((modMask x .|. controlMask, xK_t), themePrompt defaultXPConfig)
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data ThemePrompt = ThemePrompt
+
+instance XPrompt ThemePrompt where
+    showXPrompt ThemePrompt = "Select a theme: "
+    commandToComplete _ c = c
+    nextCompletion      _ = getNextCompletion
+
+themePrompt :: XPConfig -> X ()
+themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme
+    where changeTheme t = sendMessage . SetTheme . fromMaybe defaultTheme $ M.lookup t mapOfThemes
+
+mapOfThemes :: M.Map String Theme
+mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes

XMonad/Prompt/Window.hs

@@ -50,8 +50,10 @@ import XMonad.Actions.WindowBringer
 
 data WindowPrompt = Goto | Bring
 instance XPrompt WindowPrompt where
-    showXPrompt Goto  = "Go to window:  "
-    showXPrompt Bring = "Bring me here:  "
+    showXPrompt Goto      = "Go to window: "
+    showXPrompt Bring     = "Bring me here: "
+    commandToComplete _ c = c
+    nextCompletion      _ = getNextCompletion
 
 windowPromptGoto, windowPromptBring :: XPConfig -> X ()
 windowPromptGoto  c = doPrompt Goto  c
@@ -69,17 +71,9 @@ doPrompt t c = do
 
     where
 
-      winAction a m    = flip whenJust (windows . a) . flip M.lookup m . unescape
+      winAction a m    = flip whenJust (windows . a) . flip M.lookup m
       gotoAction       = winAction W.greedyView
       bringAction      = winAction bringWindow
       bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
 
-      compList m s = return . filter (isPrefixOf s) . map (escape . fst) . M.toList $ m
-
-      escape []       = []
-      escape (' ':xs) = "\\ " ++ escape xs
-      escape (x  :xs) = x : escape xs
-
-      unescape []            = []
-      unescape ('\\':' ':xs) = ' ' : unescape xs
-      unescape (x:xs)        = x   : unescape xs
+      compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m

XMonad/Prompt/Workspace.hs

@@ -18,10 +18,10 @@ module XMonad.Prompt.Workspace (
                              workspacePrompt
                               ) where
 
-import Data.List ( sort )
 import XMonad hiding ( workspaces )
 import XMonad.Prompt
 import XMonad.StackSet ( workspaces, tag )
+import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -41,7 +41,8 @@ instance XPrompt Wor where
 
 workspacePrompt :: XPConfig -> (String -> X ()) -> X ()
 workspacePrompt c job = do ws <- gets (workspaces . windowset)
-                           let ts = sort $ map tag ws
+                           sort <- getSortByIndex
+                           let ts = map tag $ sort ws
                            mkXPrompt (Wor "") c (mkCompl ts) job
 
 mkCompl :: [String] -> String -> IO [String]

XMonad/Prompt/XMonad.hs

@@ -21,7 +21,8 @@ module XMonad.Prompt.XMonad (
 
 import XMonad
 import XMonad.Prompt
-import XMonad.Actions.Commands (defaultCommands, runCommand')
+import XMonad.Actions.Commands (defaultCommands)
+import Data.Maybe (fromMaybe)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -44,8 +45,10 @@ instance XPrompt XMonad where
 xmonadPrompt :: XPConfig -> X ()
 xmonadPrompt c = do
     cmds <- defaultCommands
-    mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand'
+    xmonadPromptC cmds c
 
 -- | An xmonad prompt with a custom command list
 xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()
-xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand'
+xmonadPromptC commands c =
+    mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $
+        fromMaybe (return ()) . (`lookup` commands)

XMonad/Util/Anneal.hs

@@ -1,93 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Util.Anneal
--- Copyright   :  (c) David Roundy
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.org>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Requires the 'random' package
---
------------------------------------------------------------------------------
-
-module XMonad.Util.Anneal (-- * Usage
-                           -- $usage
-                           Rated(Rated), the_value, the_rating
-                          , anneal, annealMax ) where
-
-import System.Random ( StdGen, Random, mkStdGen, randomR )
-import Control.Monad.State ( State, runState, put, get, gets, modify )
-
--- $usage
--- See "XMonad.Layout.Mosaic" for an usage example.
-
-data Rated a b = Rated !a !b
-                 deriving ( Show )
-instance Functor (Rated a) where
-    f `fmap` (Rated v a) = Rated v (f a)
-
-the_value :: Rated a b -> b
-the_value (Rated _ b) = b
-the_rating :: Rated a b -> a
-the_rating (Rated a _) = a
-
-instance Eq a => Eq (Rated a b) where
-    (Rated a _) == (Rated a' _) = a == a'
-instance Ord a => Ord (Rated a b) where
-    compare (Rated a _) (Rated a' _) = compare a a'
-
-anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
-anneal st r sel = runAnneal st r (do_anneal sel)
-
-annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
-annealMax st r sel = runAnneal st (negate . r) (do_anneal sel)
-
-do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a)
-do_anneal sel = do sequence_ $ replicate 100 da
-                   gets best
-    where da = do select_metropolis sel
-                  modify $ \s -> s { temperature = temperature s *0.99 }
-
-data Anneal a = A { g :: StdGen
-                  , best :: Rated Double a
-                  , current :: Rated Double a
-                  , rate :: a -> Rated Double a
-                  , temperature :: Double }
-
-runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b
-runAnneal start r x = fst $ runState x (A { g = mkStdGen 137
-                                          , best = Rated (r start) start
-                                          , current = Rated (r start) start
-                                          , rate = \xx -> Rated (r xx) xx
-                                          , temperature = 1.0 })
-
-select_metropolis :: (a -> [a]) -> State (Anneal a) ()
-select_metropolis x = do c <- gets current
-                         a <- select $ x $ the_value c
-                         metropolis a
-
-metropolis :: a -> State (Anneal a) ()
-metropolis x = do r <- gets rate
-                  c <- gets current
-                  t <- gets temperature
-                  let rx = r x
-                      boltz = exp $ (the_rating c - the_rating rx) / t
-                  if rx < c then do modify $ \s -> s { current = rx, best = rx }
-                            else do p <- getOne (0,1)
-                                    if p < boltz
-                                       then modify $ \s -> s { current = rx }
-                                       else return ()
-
-select :: [a] -> State (Anneal a) a
-select [] = the_value `fmap` gets best
-select [x] = return x
-select xs = do n <- getOne (0,length xs - 1)
-               return (xs !! n)
-
-getOne :: (Random a) => (a,a) -> State (Anneal x) a
-getOne bounds = do s <- get
-                   (x,g') <- return $ randomR bounds (g s)
-                   put $ s { g = g' }
-                   return x

XMonad/Util/EZConfig.hs

@@ -2,25 +2,64 @@
 -- |
 -- Module      :  XMonad.Util.EZConfig
 -- Copyright   :  Devin Mullins <me@twifkak.com>
+--                Brent Yorgey <byorgey@gmail.com> (key parsing)
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Devin Mullins <me@twifkak.com>
 --
--- Useful helper functions for amending the defaultConfig.
+-- Useful helper functions for amending the defaultConfig, and for
+-- parsing keybindings specified in a special (emacs-like) format.
 --
 -- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)
 --
 --------------------------------------------------------------------
 
 module XMonad.Util.EZConfig (
-                             additionalKeys, removeKeys,
-                             additionalMouseBindings, removeMouseBindings
+                             -- * Usage
+                             -- $usage
+
+                             -- * Adding or removing keybindings
+
+                             additionalKeys, additionalKeysP,
+                             removeKeys, removeKeysP,
+                             additionalMouseBindings, removeMouseBindings,
+
+                             -- * Emacs-style keybinding specifications
+
+                             mkKeymap, checkKeymap,
                             ) where
--- TODO: write tests
 
 import XMonad
+import XMonad.Actions.Submap
 
 import qualified Data.Map as M
+import Data.List (foldl', intersperse, sortBy, groupBy, nub)
+import Data.Ord (comparing)
+import Data.Maybe (catMaybes, isNothing, isJust, fromJust)
+import Control.Arrow (first, (&&&))
+
+import Text.ParserCombinators.ReadP
+
+-- $usage
+-- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Util.EZConfig
+--
+-- Then, use one of the provided functions to modify your
+-- configuration.  You can use 'additionalKeys', 'removeKeys',
+-- 'additionalMouseBindings', and 'removeMouseBindings' to easily add
+-- and remove keybindings or mouse bindings.  You can use 'mkKeymap'
+-- to create a keymap using emacs-style keybinding specifications
+-- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP'
+-- and 'removeKeysP' to easily add or remove emacs-style keybindings.
+-- If you use emacs-style keybindings, the 'checkKeymap' function is
+-- provided, suitable for adding to your 'startupHook', which can warn
+-- you of any parse errors or duplicate bindings in your keymap.
+--
+-- For more information and usage eamples, see the documentation
+-- provided with each exported function, and check the xmonad config
+-- archive (<http://haskell.org/haskellwiki/Xmonad/Config_archive>)
+-- for some real examples of use.
 
 -- |
 -- Add or override keybindings from the existing set. Example use:
@@ -37,8 +76,22 @@ import qualified Data.Map as M
 -- to the modMask you configured earlier. You must specify mod1Mask (or
 -- whichever), or add your own @myModMask = mod1Mask@ line.
 additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a
-additionalKeys conf keysList =
-    conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) }
+additionalKeys conf keyList =
+    conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) }
+
+-- | Like 'additionalKeys', except using short @String@ key
+--   descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as
+--   described in the documentation for 'mkKeymap'.  For example:
+--
+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
+-- >                 `additionalKeysP`
+-- >                 [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4")
+-- >                 , ("M-<Backspace>", withFocused hide) -- N.B. this is an absurd thing to do
+-- >                 ]
+
+additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l
+additionalKeysP conf keyList =
+    conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) }
 
 -- |
 -- Remove standard keybindings you're not using. Example use:
@@ -49,13 +102,254 @@ removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a
 removeKeys conf keyList =
     conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) }
 
--- | Like additionalKeys, but for mouseBindings.
+-- | Like 'removeKeys', except using short @String@ key descriptors
+--   like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the
+--   documentation for 'mkKeymap'. For example:
+--
+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }
+-- >                 `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']]
+
+removeKeysP :: XConfig l -> [String] -> XConfig l
+removeKeysP conf keyList =
+    conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) }
+
+-- | Like 'additionalKeys', but for mouse bindings.
 additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a
 additionalMouseBindings conf mouseBindingsList =
     conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) }
 
--- | Like removeKeys, but for mouseBindings.
+-- | Like 'removeKeys', but for mouse bindings.
 removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a
 removeMouseBindings conf mouseBindingList =
     conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`
                                    M.fromList (zip mouseBindingList $ return ()) }
+
+
+--------------------------------------------------------------
+--  Keybinding parsing  ---------------------------------------
+--------------------------------------------------------------
+
+-- | Given a config (used to determine the proper modifier key to use)
+--   and a list of @(String, X ())@ pairs, create a key map by parsing
+--   the key sequence descriptions contained in the Strings.  The key
+--   sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and
+--   @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is
+--   replaced by the appropriate number) respectively; some special
+--   keys can be specified by enclosing their name in angle brackets.
+--
+--   For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\<Escape\>\"@ denotes
+--   shift-escape.
+--
+--   Sequences of keys can also be specified by separating the key
+--   descriptions with spaces. For example, @\"M-x y \<Down\>\"@ denotes the
+--   sequence of keys mod+x, y, down.  Submaps (see
+--   "XMonad.Actions.Submap") will be automatically generated to
+--   correctly handle these cases.
+--
+--   So, for example, a complete key map might be specified as
+--
+-- > keys = \c -> mkKeymap c $
+-- >     [ ("M-S-<Return>", spawn $ terminal c)
+-- >     , ("M-x w", spawn "xmessage 'woohoo!'")  -- type mod+x then w to pop up 'woohoo!'
+-- >     , ("M-x y", spawn "xmessage 'yay!'")     -- type mod+x then y to pop up 'yay!'
+-- >     , ("M-S-c", kill)
+-- >     ]
+--
+-- Alternatively, you can use 'additionalKeysP' to automatically
+-- create a keymap and add it to your config.
+--
+-- Here is a complete list of supported special keys.  Note that a few
+-- keys, such as the arrow keys, have synonyms:
+--
+-- > <Backspace>
+-- > <Tab>
+-- > <Return>
+-- > <Pause>
+-- > <Scroll_lock>
+-- > <Sys_Req>
+-- > <Escape>, <Esc>
+-- > <Delete>
+-- > <Home>
+-- > <Left>, <L>
+-- > <Up>, <U>
+-- > <Right>, <R>
+-- > <Down>, <D>
+-- > <Page_Up>
+-- > <Page_Down>
+-- > <End>
+-- > <Insert>
+-- > <Break>
+-- > <Space>
+-- > <F1>-<F12>
+
+mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
+mkKeymap c = M.fromList . mkSubmaps . readKeymap c
+
+-- | Given a list of pairs of parsed key sequences and actions,
+--   group them into submaps in the appropriate way.
+mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())]
+mkSubmaps binds = map combine gathered
+  where gathered = groupBy fstKey
+                 . sortBy (comparing fst)
+                 $ binds
+        combine [([k],act)] = (k,act)
+        combine ks = (head . fst . head $ ks,
+                      submap . M.fromList . mkSubmaps $ map (first tail) ks)
+        fstKey = (==) `on` (head . fst)
+
+on :: (a -> a -> b) -> (c -> a) -> c -> c -> b
+op `on` f = \x y -> f x `op` f y
+
+-- | Given a configuration record and a list of (key sequence
+--   description, action) pairs, parse the key sequences into lists of
+--   @(KeyMask,KeySym)@ pairs.  Key sequences which fail to parse will
+--   be ignored.
+readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())]
+readKeymap c = catMaybes . map (maybeKeys . first (readKeySequence c))
+  where maybeKeys (Nothing,_) = Nothing
+        maybeKeys (Just k, act) = Just (k, act)
+
+-- | Parse a sequence of keys, returning Nothing if there is
+--   a parse failure (no parse, or ambiguous parse).
+readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]
+readKeySequence c s = case parses s of
+    [k] -> Just k
+    _   -> Nothing
+  where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)
+
+-- | Parse a sequence of key combinations separated by spaces, e.g.
+--   @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2).
+parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)]
+parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ')
+
+-- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).
+parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)
+parseKeyCombo c = do mods <- many (parseModifier c)
+                     k <- parseKey
+                     return (foldl' (.|.) 0 mods, k)
+
+-- | Parse a modifier: either M- (user-defined mod-key),
+--   C- (control), S- (shift), or M#- where # is an integer
+--   from 1 to 5 (mod1Mask through mod5Mask).
+parseModifier :: XConfig l -> ReadP KeyMask
+parseModifier c =  (string "M-" >> return (modMask c))
+               +++ (string "C-" >> return controlMask)
+               +++ (string "S-" >> return shiftMask)
+               +++ do char 'M'
+                      n <- satisfy (`elem` ['1'..'5'])
+                      char '-'
+                      return (mod1Mask + (read [n]) - 1)
+
+-- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.
+parseKey :: ReadP KeySym
+parseKey = parseRegular +++ parseSpecial
+
+-- | Parse a regular key name (represented by itself).
+parseRegular :: ReadP KeySym
+parseRegular = choice [ char s >> return k
+                      | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde]
+                      ]
+
+-- | Parse a special key name (one enclosed in angle brackets).
+parseSpecial :: ReadP KeySym
+parseSpecial = do char '<'
+                  key <- choice [ string name >> return k
+                                | (name,k) <- keyNames
+                                ]
+                  char '>'
+                  return key
+
+-- | A list of all special key names and their associated KeySyms.
+keyNames :: [(String, KeySym)]
+keyNames = functionKeys ++ specialKeys
+
+-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with
+--   the associated KeySyms.
+functionKeys :: [(String, KeySym)]
+functionKeys = [ ("F" ++ show n, k)
+               | (n,k) <- zip ([1..12] :: [Int]) [xK_F1..] ]
+
+-- | A list of special key names and their corresponding KeySyms.
+specialKeys :: [(String, KeySym)]
+specialKeys = [ ("Backspace", xK_BackSpace)
+              , ("Tab"      , xK_Tab      )
+              , ("Return"   , xK_Return)
+              , ("Pause"    , xK_Pause)
+              , ("Scroll_lock", xK_Scroll_Lock)
+              , ("Sys_Req"  , xK_Sys_Req)
+              , ("Escape"   , xK_Escape)
+              , ("Esc"      , xK_Escape)
+              , ("Delete"   , xK_Delete)
+              , ("Home"     , xK_Home)
+              , ("Left"     , xK_Left)
+              , ("Up"       , xK_Up)
+              , ("Right"    , xK_Right)
+              , ("Down"     , xK_Down)
+              , ("L"        , xK_Left)
+              , ("U"        , xK_Up)
+              , ("R"        , xK_Right)
+              , ("D"        , xK_Down)
+              , ("Page_Up"  , xK_Page_Up)
+              , ("Page_Down", xK_Page_Down)
+              , ("End"      , xK_End)
+              , ("Insert"   , xK_Insert)
+              , ("Break"    , xK_Break)
+              , ("Space"    , xK_space)
+              ]
+
+-- | Given a configuration record and a list of (key sequence
+--   description, action) pairs, check the key sequence descriptions
+--   for validity, and warn the user (via a popup xmessage window) of
+--   any unparseable or duplicate key sequences.  This function is
+--   appropriate for adding to your @startupHook@, and you are highly
+--   encouraged to do so; otherwise, duplicate or unparseable
+--   keybindings will be silently ignored.
+--
+--   For example, you might do something like this:
+--
+-- > main = xmonad $ myConfig
+-- >
+-- > myKeymap = [("S-M-c", kill), ...]
+-- > myConfig = defaultConfig {
+-- >     ...
+-- >     keys = \c -> mkKeymap c myKeymap
+-- >     startupHook = return () >> checkKeymap myConfig myKeymap
+-- >     ...
+-- > }
+--
+-- NOTE: the @return ()@ in the example above is very important!
+-- Otherwise, you might run into problems with infinite mutual
+-- recursion: the definition of myConfig depends on the definition of
+-- startupHook, which depends on the definition of myConfig, ... and
+-- so on.  Actually, it's likely that the above example in particular
+-- would be OK without the @return ()@, but making @myKeymap@ take
+-- @myConfig@ as a parameter would definitely lead to
+-- problems. Believe me.  It, uh, happened to my friend. In... a
+-- dream. Yeah. In any event, the @return () >>@ introduces enough
+-- laziness to break the deadlock.
+--
+checkKeymap :: XConfig l -> [(String, a)] -> X ()
+checkKeymap conf km = warn (doKeymapCheck conf km)
+  where warn ([],[])   = return ()
+        warn (bad,dup) = spawn $ "xmessage 'Warning:\n"
+                            ++ msg "bad" bad ++ "\n"
+                            ++ msg "duplicate" dup ++ "'"
+        msg _ [] = ""
+        msg m xs = m ++ " keybindings detected: " ++ showBindings xs
+        showBindings = concat . intersperse " " . map ((++"\"") . ("\""++))
+
+-- | Given a config and a list of (key sequence description, action)
+--   pairs, check the key sequence descriptions for validity,
+--   returning a list of unparseable key sequences, and a list of
+--   duplicate key sequences.
+doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])
+doKeymapCheck conf km = (bad,dups)
+  where ks = map ((readKeySequence conf &&& id) . fst) km
+        bad = nub . map snd . filter (isNothing . fst) $ ks
+        dups = map (snd . head)
+             . filter ((>1) . length)
+             . groupBy ((==) `on` fst)
+             . sortBy (comparing fst)
+             . map (first fromJust)
+             . filter (isJust . fst)
+             $ ks

XMonad/Util/Font.cpphs

@@ -1,154 +0,0 @@
-----------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Util.Font
--- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen
--- License     :  BSD-style (see xmonad/LICENSE)
---
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module for abstracting a font facility over Core fonts and Xft
---
------------------------------------------------------------------------------
-
-module XMonad.Util.Font  (
-                             -- * Usage:
-                             -- $usage
-                             XMonadFont(..)
-                             , initXMF
-                             , releaseXMF
-                             , initCoreFont
-                             , releaseCoreFont
-                             , Align (..)
-                             , stringPosition
-                             , textWidthXMF
-                             , textExtentsXMF
-                             , printStringXMF
-                             , stringToPixel
-                            ) where
-
-
-import XMonad
-import Foreign
-
-#ifdef XFT
-import Data.List
-import Graphics.X11.Xft
-import Graphics.X11.Xrender
-#endif
-
--- Hide the Core Font/Xft switching here
-data XMonadFont = Core FontStruct
-#ifdef XFT
-                | Xft  XftFont
-#endif
-
--- $usage
--- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples
-
--- | Get the Pixel value for a named color: if an invalid name is
--- given the black pixel will be returned.
-stringToPixel :: MonadIO m => Display -> String -> m Pixel
-stringToPixel d s = liftIO $ catch getIt fallBack
-    where getIt    = initColor d s
-          fallBack = const $ return $ blackPixel d (defaultScreen d)
-
-
--- | Given a fontname returns the font structure. If the font name is
---  not valid the default font will be loaded and returned.
-initCoreFont :: String -> X FontStruct
-initCoreFont s = do
-  d <- asks display
-  io $ catch (getIt d) (fallBack d)
-      where getIt    d = loadQueryFont d s
-            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-
-releaseCoreFont :: FontStruct -> X ()
-releaseCoreFont fs = do
-  d <- asks display
-  io $ freeFont d fs
-
--- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend
--- Example: 'xft: Sans-10'
-initXMF :: String -> X XMonadFont
-initXMF s =
-#ifdef XFT
-  if xftPrefix `isPrefixOf` s then
-     do
-       dpy <- asks display
-       xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)
-       return (Xft xftdraw)
-  else
-#endif
-      (initCoreFont s >>= (return . Core))
-#ifdef XFT
-  where xftPrefix = "xft:"
-#endif
-
-releaseXMF :: XMonadFont -> X ()
-releaseXMF (Core fs) = releaseCoreFont fs
-#ifdef XFT
-releaseXMF (Xft xftfont) = do
-  dpy <- asks display
-  io $ xftFontClose dpy xftfont
-#endif
-
-textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
-textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s
-#ifdef XFT
-textWidthXMF dpy (Xft xftdraw) s = liftIO $ do
-    gi <- xftTextExtents dpy xftdraw s
-    return $ xglyphinfo_width gi
-#endif
-
-textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)
-textExtentsXMF (Core fs) s = return $ textExtents fs s
-#ifdef XFT
-textExtentsXMF (Xft xftfont) _ = liftIO $ do
-    ascent <- xftfont_ascent xftfont
-    descent <- xftfont_descent xftfont
-    return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched")
-#endif
-
--- | String position
-data Align = AlignCenter | AlignRight | AlignLeft
-
--- | Return the string x and y 'Position' in a 'Rectangle', given a
--- 'FontStruct' and the 'Align'ment
-stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position)
-stringPosition fs (Rectangle _ _ w h) al s = do
-  dpy <- asks display
-  width <- io $ textWidthXMF dpy fs s
-  (_,a,d,_) <- io $ textExtentsXMF fs s
-  let y         = fi $ ((h - fi (a + d)) `div` 2) + fi a;
-      x         = case al of
-                     AlignCenter -> fi (w `div` 2) - fi (width `div` 2)
-                     AlignLeft   -> 1
-                     AlignRight  -> fi (w - (fi width + 1));
-  return (x,y)
-
-
-printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String
-            -> Position -> Position -> String  -> m ()
-printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do
-         setFont d gc $ fontFromFontStruct fs
-         [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
-         setForeground   d gc fc'
-         setBackground   d gc bc'
-         drawImageString d p gc x y s
-
-#ifdef XFT
-printStringXMF dpy drw (Xft font) _ fc _ x y s = do
-  let screen = defaultScreenOfDisplay dpy;
-      colormap = defaultColormapOfScreen screen;
-      visual = defaultVisualOfScreen screen;
-  liftIO $ withXftDraw dpy drw visual colormap $
-         \draw -> withXftColorName dpy visual colormap fc $
-                   \color -> xftDrawString draw color font x y s
-#endif
-
-
--- | Short-hand for 'fromIntegral'
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral

XMonad/Util/Font.hsc

@@ -0,0 +1,226 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Font
+-- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for abstracting a font facility over Core fonts and Xft
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Font
+    ( -- * Usage:
+      -- $usage
+      XMonadFont(..)
+    , initXMF
+    , releaseXMF
+    , initCoreFont
+    , releaseCoreFont
+    , initUtf8Font
+    , releaseUtf8Font
+    , Align (..)
+    , stringPosition
+    , textWidthXMF
+    , textExtentsXMF
+    , printStringXMF
+    , stringToPixel
+    , decodeInput
+    , encodeOutput
+    ) where
+
+import XMonad
+import Foreign
+import Control.Applicative
+import Data.Maybe
+
+#ifdef XFT
+import Data.List
+import Graphics.X11.Xft
+import Graphics.X11.Xrender
+#endif
+
+#if defined XFT || defined UTF8
+import Codec.Binary.UTF8.String (encodeString, decodeString)
+import Foreign.C
+#endif
+
+-- Hide the Core Font/Xft switching here
+data XMonadFont = Core FontStruct
+                | Utf8 FontSet
+#ifdef XFT
+                | Xft  XftFont
+#endif
+
+-- $usage
+-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples
+
+-- | Get the Pixel value for a named color: if an invalid name is
+-- given the black pixel will be returned.
+stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel
+stringToPixel d s = fromMaybe fallBack <$> io getIt
+    where getIt    = initColor d s
+          fallBack = blackPixel d (defaultScreen d)
+
+
+-- | Given a fontname returns the font structure. If the font name is
+--  not valid the default font will be loaded and returned.
+initCoreFont :: String -> X FontStruct
+initCoreFont s = do
+  d <- asks display
+  io $ catch (getIt d) (fallBack d)
+      where getIt    d = loadQueryFont d s
+            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+
+releaseCoreFont :: FontStruct -> X ()
+releaseCoreFont fs = do
+  d <- asks display
+  io $ freeFont d fs
+
+initUtf8Font :: String -> X FontSet
+initUtf8Font s = do
+  d <- asks display
+  (_,_,fs) <- io $ catch (getIt d) (fallBack d)
+  return fs
+      where getIt    d = createFontSet d s
+            fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+
+releaseUtf8Font :: FontSet -> X ()
+releaseUtf8Font fs = do
+  d <- asks display
+  io $ freeFontSet d fs
+
+-- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend
+-- Example: 'xft: Sans-10'
+initXMF :: String -> X XMonadFont
+initXMF s =
+#ifdef XFT
+  if xftPrefix `isPrefixOf` s then
+     do io setupLocale
+        dpy <- asks display
+        xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)
+        return (Xft xftdraw)
+  else
+#endif
+#ifdef UTF8
+      (io setupLocale >> initUtf8Font s >>= (return . Utf8))
+#else
+      (initCoreFont s >>= (return . Core))
+#endif
+#ifdef XFT
+  where xftPrefix = "xft:"
+#endif
+
+releaseXMF :: XMonadFont -> X ()
+#ifdef XFT
+releaseXMF (Xft xftfont) = do
+  dpy <- asks display
+  io $ xftFontClose dpy xftfont
+#endif
+releaseXMF (Utf8 fs) = releaseUtf8Font fs
+releaseXMF (Core fs) = releaseCoreFont fs
+
+
+textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int
+textWidthXMF _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s
+textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s
+#ifdef XFT
+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do
+    gi <- xftTextExtents dpy xftdraw s
+    return $ xglyphinfo_xOff gi
+#endif
+
+textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)
+textExtentsXMF (Utf8 fs) s = do
+  let (_,rl)  = wcTextExtents fs s
+      ascent  = fi $ - (rect_y rl)
+      descent = fi $ rect_height rl + (fi $ rect_y rl)
+  return (ascent, descent)
+textExtentsXMF (Core fs) s = do
+  let (_,a,d,_) = textExtents fs s
+  return (a,d)
+#ifdef XFT
+textExtentsXMF (Xft xftfont) _ = io $ do
+  ascent  <- fi `fmap` xftfont_ascent  xftfont
+  descent <- fi `fmap` xftfont_descent xftfont
+  return (ascent, descent)
+#endif
+
+-- | String position
+data Align = AlignCenter | AlignRight | AlignLeft
+
+-- | Return the string x and y 'Position' in a 'Rectangle', given a
+-- 'FontStruct' and the 'Align'ment
+stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position)
+stringPosition dpy fs (Rectangle _ _ w h) al s = do
+  width <- textWidthXMF dpy fs s
+  (a,d) <- textExtentsXMF fs s
+  let y = fi $ ((h - fi (a + d)) `div` 2) + fi a;
+      x = case al of
+            AlignCenter -> fi (w `div` 2) - fi (width `div` 2)
+            AlignLeft   -> 1
+            AlignRight  -> fi (w - (fi width + 1));
+  return (x,y)
+
+printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String
+            -> Position -> Position -> String  -> m ()
+printStringXMF d p (Core fs) gc fc bc x y s = io $ do
+    setFont d gc $ fontFromFontStruct fs
+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+    setForeground d gc fc'
+    setBackground d gc bc'
+    drawImageString d p gc x y s
+printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do
+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]
+    setForeground d gc fc'
+    setBackground d gc bc'
+    io $ wcDrawImageString d p fs gc x y s
+#ifdef XFT
+printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do
+  let screen   = defaultScreenOfDisplay dpy
+      colormap = defaultColormapOfScreen screen
+      visual   = defaultVisualOfScreen screen
+  bcolor <- stringToPixel dpy bc
+  (a,d)  <- textExtentsXMF fs s
+  gi <- io $ xftTextExtents dpy font s
+  io $ setForeground dpy gc bcolor
+  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))
+                                (y - fi a)
+                                (fi $ xglyphinfo_xOff gi)
+                                (fi $ a + d)
+  io $ withXftDraw dpy drw visual colormap $
+         \draw -> withXftColorName dpy visual colormap fc $
+                   \color -> xftDrawString draw color font x y s
+#endif
+
+decodeInput :: String -> String
+#if defined XFT || defined UTF8
+decodeInput = decodeString
+#else
+decodeInput = id
+#endif
+
+encodeOutput :: String -> String
+#if defined XFT || defined UTF8
+encodeOutput = encodeString
+#else
+encodeOutput = id
+#endif
+
+-- | Short-hand for 'fromIntegral'
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+#if defined XFT || defined UTF8
+#include <locale.h>
+foreign import ccall unsafe "locale.h setlocale"
+    setlocale :: CInt -> CString -> IO CString
+
+setupLocale :: IO ()
+setupLocale = withCString "" $ \s -> do
+                setlocale (#const LC_ALL) s
+                return ()
+#endif

XMonad/Util/Loggers.hs

@@ -0,0 +1,88 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Loggers
+-- Copyright   :  (c) Brent Yorgey
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A collection of simple logger functions which can be used in the
+-- 'XMonad.Hooks.DynamicLog.ppExtras' field of a pretty-printing status
+-- logger format. See "XMonad.Hooks.DynamicLog" for more information.
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Loggers (
+                            -- * Usage
+                            -- $usage
+
+                             Logger
+
+                           , date
+                           , loadAvg
+                           , battery
+                           , logCmd
+
+                           ) where
+
+import XMonad.Core
+
+import System.Time
+import System.IO
+import System.Process
+import System.Locale
+
+-- $usage
+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Util.Loggers
+--
+-- Then, add one or more loggers to the
+-- 'XMonad.Hooks.DynamicLog.ppExtras' field of your
+-- 'XMonad.Hooks.DynamicLoc.PP' format.  For example:
+--
+-- >     -- display load averages and a pithy quote along with xmonad status.
+-- >   , logHook = dynamicLogWithPP $ defaultPP { ppExtras = [ loadAvg, logCmd "fortune -n 40 -s" ] }
+--
+-- Of course, there is nothing really special about these so-called
+-- \'loggers\': they are just @X (Maybe String)@ actions.  So you can
+-- use them anywhere you would use an @X (Maybe String)@, not just
+-- with DynamicLog.
+--
+-- Additional loggers welcome!
+--
+
+-- | 'Logger' is just a convenient synonym for @X (Maybe String)@.
+type Logger = X (Maybe String)
+
+-- | Get the current date and time, and format them via the
+--   given format string.  The format used is the same as that used
+--   by the C library function strftime; for example,
+--   @date \"%a %b %d\"@ might display something like @Tue Feb 19@.
+--   For more information see something like
+--   <http://www.cplusplus.com/reference/clibrary/ctime/strftime.html>.
+date :: String -> Logger
+date fmt = io $ do cal <- (getClockTime >>= toCalendarTime)
+                   return . Just $ formatCalendarTime defaultTimeLocale fmt cal
+
+-- | Get the load average.  This assumes that you have a
+--   utility called @\/usr\/bin\/uptime@ and that you have @sed@
+--   installed; these are fairly common on GNU\/Linux systems but it
+--   would be nice to make this more general.
+loadAvg :: Logger
+loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'"
+
+-- | Get the battery status (percent charge and charging\/discharging
+--   status). This is an ugly hack and may not work for some people.
+--   At some point it would be nice to make this more general\/have
+--   fewer dependencies.
+battery :: Logger
+battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'"
+
+-- | Create a 'Logger' from an arbitrary shell command.
+logCmd :: String -> Logger
+logCmd c = io $ do (_, out, _, proc) <- runInteractiveCommand c
+                   output <- hGetLine out
+                   waitForProcess proc
+                   return $ Just output

XMonad/Util/Run.hs

@@ -56,13 +56,13 @@ runProcessWithInput cmd args input = do
     hPutStr pin input
     hClose pin
     output <- hGetContents pout
-    when (output==output) $ return ()
+    when (output == output) $ return ()
     hClose pout
     hClose perr
     waitForProcess ph
     return output
 
--- | Wait is in us
+-- | Wait is in µs (microseconds)
 runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()
 runProcessWithInputAndWait cmd args input timeout = do
     doubleFork $ do
@@ -85,41 +85,42 @@ runProcessWithInputAndWait cmd args input timeout = do
 seconds :: Rational -> Int
 seconds = fromEnum . (* 1000000)
 
--- | safeSpawn bypasses XMonad's 'spawn' command, because 'spawn' passes
--- strings to \/bin\/sh to be interpreted as shell commands. This is
--- often what one wants, but in many cases the passed string will contain
--- shell metacharacters which one does not want interpreted as such (URLs
--- particularly often have shell metacharacters like \'&\' in them). In
--- this case, it is more useful to specify a file or program to be run
--- and a string to give it as an argument so as to bypass the shell and
--- be certain the program will receive the string as you typed it.
--- unsafeSpawn is an alias for XMonad's 'spawn', to remind one that use
--- of it can be, well, unsafe.
--- Examples:
---
--- >     , ((modMask, xK_Print), unsafeSpawn "import -window root png:$HOME/xwd-$(date +%s)$$.png")
--- >     , ((modMask, xK_d    ), safeSpawn "firefox" "")
---
--- Note that the unsafeSpawn example must be unsafe and not safe because
--- it makes use of shell interpretation by relying on @$HOME@ and
--- interpolation, whereas the safeSpawn example can be safe because
--- Firefox doesn't need any arguments if it is just being started.
+{- | 'safeSpawn' bypasses "XMonad.Core"'s 'spawn' command, because spawn passes
+strings to \/bin\/sh to be interpreted as shell commands. This is
+often what one wants, but in many cases the passed string will contain
+shell metacharacters which one does not want interpreted as such (URLs
+particularly often have shell metacharacters like \'&\' in them). In
+this case, it is more useful to specify a file or program to be run
+and a string to give it as an argument so as to bypass the shell and
+be certain the program will receive the string as you typed it.
+unsafeSpawn is internally an alias for XMonad's 'spawn', to remind one that use
+of it can be, well, unsafe.
+Examples:
+
+> , ((modMask, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png")
+> , ((modMask, xK_d    ), safeSpawn "firefox" "")
+
+Note that the unsafeSpawn example must be unsafe and not safe because
+it makes use of shell interpretation by relying on @$HOME@ and
+interpolation, whereas the safeSpawn example can be safe because
+Firefox doesn't need any arguments if it is just being started. -}
 safeSpawn :: MonadIO m => FilePath -> String -> m ()
 safeSpawn prog arg = liftIO (try (doubleFork $ executeFile prog True [arg] Nothing) >> return ())
 
 unsafeSpawn :: MonadIO m => String -> m ()
 unsafeSpawn = spawn
 
--- | Run a given program in the preferred terminal emulator. This uses
--- 'safeSpawn'.
-safeRunInTerm :: String -> X ()
-safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command)
-
-unsafeRunInTerm, runInTerm :: String -> X ()
-unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command
+-- | Open a terminal emulator. The terminal emulator is specified in @defaultConfig@ as xterm by default. It is then
+-- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn'
+unsafeRunInTerm, runInTerm :: String -> String -> X ()
+unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command
 runInTerm = unsafeRunInTerm
 
--- | Launch an external application and return a 'Handle' to its standard input.
+-- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'.
+safeRunInTerm :: String -> String -> X ()
+safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command)
+
+-- | Launch an external application through the system shell and return a @Handle@ to its standard input.
 spawnPipe :: String -> IO Handle
 spawnPipe x = do
     (rd, wr) <- createPipe

XMonad/Util/Scratchpad.hs

@@ -0,0 +1,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Scratchpad
+-- Copyright   :  (c) Braden Shepherdson 2008
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  Braden.Shepherdson@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Very handy hotkey-launched floating terminal window.
+--
+-- A tool like detach (<http://detach.sourceforge.net>) turns it
+-- into a launchpad for X apps.
+--
+-- By default, your xmonad terminal is used, and mod+s is the hotkey.
+-- The default ManageHook uses a centered, half-screen-wide,
+-- quarter-screen-tall window.
+-- The key, position and size are configurable.
+--
+-- The terminal application must support the @-title@ argument.
+-- Known supported terminals: rxvt, rxvt-unicode, xterm.
+-- Most others are likely to follow the lead set by xterm.
+--
+-- Add the following to your xmonad.hs keybindings to use the default mod+s:
+--
+-- > scratchpadSpawnDefault conf
+--
+-- Or specify your own key binding, with the action:
+--
+-- > scratchpadSpawnAction conf
+--
+-- And add one of the @scratchpadManageHook*@s to your ManageHook list.
+-- The default rectangle is half the screen wide and a quarter of the
+-- screen tall, centered.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Scratchpad (
+  scratchpadSpawnDefault
+  ,scratchpadSpawnAction
+  ,scratchpadManageHookDefault
+  ,scratchpadManageHook
+  ) where
+
+import XMonad
+import XMonad.Core
+import XMonad.Hooks.ManageHelpers (doRectFloat)
+import qualified XMonad.StackSet
+
+
+
+-- | Complete key binding. Pops up the terminal on mod+s.
+scratchpadSpawnDefault :: XConfig l -- ^ The configuration, to retrieve terminal and modMask
+                       -> ((KeyMask, KeySym), X ())
+scratchpadSpawnDefault conf = ((modMask conf, xK_s), scratchpadSpawnAction conf)
+
+
+-- | Action to pop up the terminal, for the user to bind to a custom key.
+scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal
+                      -> X ()
+scratchpadSpawnAction conf = spawn $ terminal conf ++ " -title scratchpad"
+
+
+
+-- | The ManageHook, with the default rectangle:
+-- Half the screen wide, a quarter of the screen tall, centered.
+scratchpadManageHookDefault :: ManageHook
+scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect
+
+
+-- | The ManageHook, with a user-specified StackSet.RationalRect.
+scratchpadManageHook :: XMonad.StackSet.RationalRect -- ^ User-specified screen rectangle.
+                     -> ManageHook
+scratchpadManageHook rect = title =? "scratchpad" --> doRectFloat rect
+
+
+scratchpadDefaultRect :: XMonad.StackSet.RationalRect
+scratchpadDefaultRect = XMonad.StackSet.RationalRect 0.25 0.375 0.5 0.25
+
+

XMonad/Util/Themes.hs

@@ -0,0 +1,203 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Themes
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A (hopefully) growing collection of themes for decorated layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Util.Themes
+    ( -- * Usage
+      -- $usage
+      listOfThemes
+    , ppThemeInfo
+    , xmonadTheme
+    , smallClean
+    , robertTheme
+    , deiflTheme
+    , oxymor00nTheme
+    , donaldTheme
+    , wfarrTheme
+    , ThemeInfo (..)
+    ) where
+
+import XMonad.Layout.Decoration
+
+-- $usage
+-- This module stores some user contributed themes which can be used
+-- with decorated layouts (such as Tabbed).  (Note that these themes
+-- only apply to decorated layouts, such as those found in
+-- "XMonad.Layout.Tabbed" and "XMonad.Layout.DecorationMadness"; they
+-- do not apply to xmonad as a whole.)
+--
+-- If you want to use one of them with one of your decorated layouts,
+-- you need to substitute defaultTheme with, for instance, (theme
+-- smallClean).
+--
+-- Here is an example:
+--
+-- > import XMonad
+-- > import XMonad.Util.Themes
+-- > import XMonad.Layout.Tabbed
+-- >
+-- > myLayout = tabbed shrinkText (theme smallClean)
+-- >
+-- > main = xmonad defaultConfig {layoutHook = myLayout}
+--
+-- If you have a theme you would like to share, adding it to this
+-- module is very easy.
+--
+-- You can use 'xmonadTheme' or 'smallClean' as a template.
+--
+-- At the present time only the 'themeName' field is used. But please
+-- provide all the other information, which will be used at a later
+-- time.
+--
+-- Please, remember to add your theme to the list of exported
+-- functions, and to the 'listOfThemes'.
+--
+-- Thanks for your contribution!
+
+data ThemeInfo =
+    TI { themeName        :: String
+       , themeAuthor      :: String
+       , themeDescription :: String
+       , theme            :: Theme
+       }
+
+newTheme :: ThemeInfo
+newTheme = TI "" "" "" defaultTheme
+
+ppThemeInfo :: ThemeInfo -> String
+ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t
+    where "" <> x = x
+          x <> y = x ++ " - " ++ y
+
+
+listOfThemes :: [ThemeInfo]
+listOfThemes = [ xmonadTheme
+               , smallClean
+               , deiflTheme
+               , oxymor00nTheme
+               , robertTheme
+               , donaldTheme
+               , wfarrTheme
+               ]
+
+-- | The default xmonad theme, by David Roundy.
+xmonadTheme :: ThemeInfo
+xmonadTheme =
+    newTheme { themeName        = "xmonadTheme"
+             , themeAuthor      = "David Roundy"
+             , themeDescription = "The default xmonad theme"
+             , theme            = defaultTheme
+             }
+
+-- | Small decorations with a Ion3 remembrance, by Andrea Rossato.
+smallClean :: ThemeInfo
+smallClean =
+    newTheme { themeName        = "smallClean"
+             , themeAuthor      = "Andrea Rossato"
+             , themeDescription = "Small decorations with a Ion3 remembrance"
+             , theme            = defaultTheme { activeColor         = "#8a999e"
+                                               , inactiveColor       = "#545d75"
+                                               , activeBorderColor   = "white"
+                                               , inactiveBorderColor = "grey"
+                                               , activeTextColor     = "white"
+                                               , inactiveTextColor   = "grey"
+                                               , decoHeight          = 14
+                                               }
+             }
+
+-- | Don's prefered colors - from DynamicLog...;)
+donaldTheme  :: ThemeInfo
+donaldTheme =
+    newTheme { themeName        = "donaldTheme"
+             , themeAuthor      = "Andrea Rossato"
+             , themeDescription = "Don's prefered colors - from DynamicLog...;)"
+             , theme            = defaultTheme { activeColor         = "#2b4f98"
+                                               , inactiveColor       = "#cccccc"
+                                               , activeBorderColor   = "#2b4f98"
+                                               , inactiveBorderColor = "#cccccc"
+                                               , activeTextColor     = "white"
+                                               , inactiveTextColor   = "black"
+                                               , decoHeight          = 16
+                                               }
+             }
+
+-- | Ffrom Robert Manea's prompt theme.
+robertTheme  :: ThemeInfo
+robertTheme =
+    newTheme { themeName        = "robertTheme"
+             , themeAuthor      = "Andrea Rossato"
+             , themeDescription = "From Robert Manea's prompt theme"
+             , theme            = defaultTheme { activeColor         = "#aecf96"
+                                               , inactiveColor       = "#111111"
+                                               , activeBorderColor   = "#aecf96"
+                                               , inactiveBorderColor = "#111111"
+                                               , activeTextColor     = "black"
+                                               , inactiveTextColor   = "#d5d3a7"
+                                               , fontName            = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859"
+                                               , decoHeight          = 16
+                                               }
+             }
+
+-- | deifl\'s Theme, by deifl.
+deiflTheme :: ThemeInfo
+deiflTheme =
+    newTheme { themeName        = "deiflTheme"
+             , themeAuthor      = "deifl"
+             , themeDescription = "deifl's Theme"
+             , theme            = defaultTheme { inactiveBorderColor = "#708090"
+                                               , activeBorderColor   = "#5f9ea0"
+                                               , activeColor         = "#000000"
+                                               , inactiveColor       = "#333333"
+                                               , inactiveTextColor   = "#888888"
+                                               , activeTextColor     = "#87cefa"
+                                               , fontName            = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*"
+                                               , decoHeight          = 15
+                                               }
+             }
+
+-- | oxymor00n\'s theme, by Tom Rauchenwald.
+oxymor00nTheme :: ThemeInfo
+oxymor00nTheme =
+    newTheme { themeName        = "oxymor00nTheme"
+             , themeAuthor      = "Tom Rauchenwald"
+             , themeDescription = "oxymor00n's theme"
+             , theme            = defaultTheme { inactiveBorderColor = "#000"
+                                               , activeBorderColor = "aquamarine3"
+                                               , activeColor = "aquamarine3"
+                                               , inactiveColor = "DarkSlateGray4"
+                                               , inactiveTextColor = "#222"
+                                               , activeTextColor = "#222"
+                                               -- This font can be found in the package ttf-alee
+                                               -- on debian-systems
+                                               , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*"
+                                               , decoHeight = 15
+                                               , urgentColor = "#000"
+                                               , urgentTextColor = "#63b8ff"
+                                               }
+             }
+
+wfarrTheme :: ThemeInfo
+wfarrTheme =
+    newTheme { themeName        = "wfarrTheme"
+             , themeAuthor      = "Will Farrington"
+             , themeDescription = "A nice blue/black theme."
+             , theme            = defaultTheme { activeColor         = "#4c7899"
+                                               , inactiveColor       = "#333333"
+                                               , activeBorderColor   = "#285577"
+                                               , inactiveBorderColor = "#222222"
+                                               , activeTextColor     = "#ffffff"
+                                               , inactiveTextColor   = "#888888"
+                                               , fontName            = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1"
+                                               , decoHeight          = 12
+                                               }
+             }

XMonad/Util/WindowProperties.hs

@@ -0,0 +1,59 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.WindowProperties
+-- Copyright   :  (c) Roman Cheplyaka
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- EDSL for specifying window properties, such as title, classname or resource.
+--
+-----------------------------------------------------------------------------
+module XMonad.Util.WindowProperties (
+    -- * Usage
+    -- $usage
+    Property(..), hasProperty, focusedHasProperty)
+where
+import XMonad
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module allows to specify window properties, such as title, classname or
+-- resource, and to check them.
+--
+-- In contrast to ManageHook properties, these are instances of Show and Read,
+-- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM"
+
+-- | Property constructors are quite self-explaining.
+data Property = Title String
+              | ClassName String
+              | Resource String
+              | And Property Property  
+              | Or  Property Property
+              | Not Property
+              | Const Bool
+              deriving (Read, Show)
+infixr 9 `And`
+infixr 8 `Or`
+
+-- | Does given window have this property?
+hasProperty :: Property -> Window -> X Bool
+hasProperty (Title s)     w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w
+hasProperty (Resource s)  w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w
+hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w
+hasProperty (And p1 p2)   w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 }
+hasProperty (Or p1 p2)    w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 }
+hasProperty (Not p1)      w = do { r1 <- hasProperty p1 w; return $ not r1 }
+hasProperty (Const b)     _ = return b
+
+-- | Does the focused window have this property?
+focusedHasProperty :: Property -> X Bool
+focusedHasProperty p = do
+    ws <- gets windowset
+    let ms = W.stack $ W.workspace $ W.current ws
+    case ms of
+        Just s  -> hasProperty p $ W.focus s
+        Nothing -> return False
+

XMonad/Util/WorkspaceCompare.hs

@@ -9,12 +9,25 @@
 -- Portability :  unportable
 --
 
-module XMonad.Util.WorkspaceCompare ( getWsIndex, getWsCompare, getSortByTag ) where
+module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort
+                                    , getWsIndex
+                                    , getWsCompare
+                                    , getWsCompareByTag
+                                    , getXineramaWsCompare
+                                    , mkWsSort
+                                    , getSortByIndex
+                                    , getSortByTag
+                                    , getSortByXineramaRule ) where
 
 import XMonad
 import qualified XMonad.StackSet as S
 import Data.List
 import Data.Monoid
+import Data.Ord
+import Data.Maybe
+
+type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering
+type WorkspaceSort = [WindowSpace] -> [WindowSpace]
 
 -- | Lookup the index of a workspace id in the user's config, return Nothing
 -- if that workspace does not exist in the config.
@@ -23,19 +36,59 @@ getWsIndex = do
     spaces <- asks (workspaces . config)
     return $ flip elemIndex spaces
 
--- | A comparison function for WorkspaceId
-getWsCompare :: X (WorkspaceId -> WorkspaceId -> Ordering)
+-- | A comparison function for WorkspaceId, based on the index of the
+--   tags in the user's config.
+getWsCompare :: X WorkspaceCompare
 getWsCompare = do
     wsIndex <- getWsIndex
     return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b
- where
-   f Nothing Nothing   = EQ
-   f (Just _) Nothing  = LT
-   f Nothing (Just _)  = GT
-   f (Just x) (Just y) = compare x y
+  where
+    f Nothing Nothing   = EQ
+    f (Just _) Nothing  = LT
+    f Nothing (Just _)  = GT
+    f (Just x) (Just y) = compare x y
+
+-- | A simple comparison function that orders workspaces
+--   lexicographically by tag.
+getWsCompareByTag :: X WorkspaceCompare
+getWsCompareByTag = return compare
+
+-- | A comparison function for Xinerama based on visibility, workspace
+--   and screen id. It produces the same ordering as
+--   'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'.
+getXineramaWsCompare :: X WorkspaceCompare
+getXineramaWsCompare = do
+    w <- gets windowset
+    return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of
+        (True, True)   -> comparing (tagToSid (onScreen w)) a b
+        (False, False) -> compare a b
+        (True, False)  -> LT
+        (False, True)  -> GT
+  where
+    onScreen w =  S.current w : S.visible w
+    isOnScreen a w  = a `elem` map (S.tag . S.workspace) (onScreen w)
+    tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s
+
+-- | Create a workspace sorting function from a workspace comparison
+--   function.
+mkWsSort :: X WorkspaceCompare -> X WorkspaceSort
+mkWsSort cmpX = do
+  cmp <- cmpX
+  return $ sortBy (\a b -> cmp (S.tag a) (S.tag b))
+
+-- | Sort several workspaces according to their tags' indices in the
+--   user's config.
+getSortByIndex :: X WorkspaceSort
+getSortByIndex = mkWsSort getWsCompare
+
+-- | Sort workspaces lexicographically by tag.
+getSortByTag :: X WorkspaceSort
+getSortByTag = mkWsSort getWsCompareByTag
+
+-- | Sort serveral workspaces for xinerama displays, in the same order
+--   produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first
+--   visible workspaces, sorted by screen, then hidden workspaces,
+--   sorted by tag.
+getSortByXineramaRule :: X WorkspaceSort
+getSortByXineramaRule = mkWsSort getXineramaWsCompare
 
--- | Sort several workspaces according to the order in getWsCompare
-getSortByTag :: X ([WindowSpace] -> [WindowSpace])
-getSortByTag = do
-    cmp <- getWsCompare
-    return $ sortBy (\a b -> cmp (S.tag a) (S.tag b))

XMonad/Util/XSelection.hs

@@ -1,22 +1,20 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonad.Util.XSelection
--- Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman
--- License     :  BSD3
---
--- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>,
---                Matthew Sackman <matthew@wellquite.org>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting).
--- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available:
---
--- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils"
------------------------------------------------------------------------------
+{- |
+Module      :  XMonad.Util.XSelection
+Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman
+License     :  BSD3
 
-module XMonad.Util.XSelection (
-                                 -- * Usage
+Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>,
+               Matthew Sackman <matthew@wellquite.org>
+Stability   :  unstable
+Portability :  unportable
+
+A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).
+'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available:
+
+> $ darcs get <http://gorgias.mine.nu/repos/xmonad-utils>
+-}
+
+module XMonad.Util.XSelection (  -- * Usage
                                  -- $usage
                                  getSelection,
                                  promptSelection,
@@ -34,26 +32,28 @@ import XMonad
 import XMonad.Util.Run (safeSpawn, unsafeSpawn)
 
 {- $usage
-    Add 'import XMonad.Util.XSelection' to the top of Config.hs
-    Then make use of getSelection or promptSelection as needed; if
-    one wanted to run Firefox with the selection as an argument (say,
-    the selection is an URL you just highlighted), then one could add
-    to the Config.hs a line like thus:
+   Add @import XMonad.Util.XSelection@ to the top of Config.hs
+   Then make use of getSelection or promptSelection as needed; if
+   one wanted to run Firefox with the selection as an argument (perhaps
+   the selection string is an URL you just highlighted), then one could add
+   to the xmonad.hs a line like thus:
 
->  , ((modMask .|. shiftMask, xK_b     ), promptSelection "firefox")
+   > , ((modMask .|. shiftMask, xK_b), promptSelection "firefox")
 
-    TODO:
-             * Fix Unicode handling. Currently it's still better than calling
-               'chr' to translate to ASCII, though.
-               As near as I can tell, the mangling happens when the String is
-               outputted somewhere, such as via promptSelection's passing through
-               the shell, or GHCi printing to the terminal. utf-string has IO functions
-               which can fix this, though I do not know have to use them here. It's
-               a complex issue; see
-               <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
-               and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
+   There are a number of known problems with XSelection:
 
-             * Possibly add some more elaborate functionality: Emacs' registers are nice. -}
+    * Unicode handling is busted. But it's still better than calling
+      'chr' to translate to ASCII, at least.
+      As near as I can tell, the mangling happens when the String is
+      outputted somewhere, such as via promptSelection's passing through
+      the shell, or GHCi printing to the terminal. utf-string has IO functions
+      which can fix this, though I do not know have to use them here. It's
+      a complex issue; see
+      <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>
+      and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.
+
+    * Needs more elaborate functionality: Emacs' registers are nice; if you
+      don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -}
 
 -- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is
 -- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.
@@ -79,7 +79,7 @@ getSelection = io $ do
                return $ decode . map fromIntegral . fromMaybe [] $ res
        else destroyWindow dpy win >> return ""
 
--- | Set the current X Selection to a given String.
+-- | Set the current X Selection to a specified string.
 putSelection :: MonadIO m => String -> m ()
 putSelection text = io $ do
   dpy <- openDisplay ""
@@ -116,24 +116,27 @@ putSelection text = io $ do
                                                                print ev
                                                       processEvent dpy ty text e
 
-{- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument.
+{- | A wrapper around 'getSelection'. Makes it convenient to run a program with the current selection as an argument.
 This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to
          @promptSelection \"firefox\"@;
 this would allow you to highlight a URL string and then immediately open it up in Firefox.
 
-promptSelection passes strings through the shell; if you do not wish your selected text to be interpreted/mangled
-by the shell, use safePromptSelection which will bypass the shell using safeSpawn from Run.hs; see Run.hs for more
-details on the advantages/disadvantages of this. -}
+'promptSelection' passes strings through the system shell, \/bin\/sh; if you do not wish your selected text
+to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the
+shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more
+details on the advantages and disadvantages of using safeSpawn. -}
 promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()
 promptSelection = unsafePromptSelection
 safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)
 unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection
 
 {- | Decode a UTF8 string packed into a list of Word8 values, directly to
-   String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'.
-   UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library
-   <http://code.haskell.org/utf8-string/> (version 0.1), which is BSD-3 licensed, as is this module.
-   It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough
+   String; does not deal with CChar, hence you will want the counter-intuitive @map fromIntegral@
+   UTF-8 decoding for internal use in getSelection.
+
+   This code is copied from Eric Mertens's "utf-string" library <http://code.haskell.org/utf8-string/>
+   (as of version 0.1),\which is BSD-3 licensed like this module.
+   It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough
    dependencies already. -}
 decode :: [Word8] -> String
 decode [    ] = ""
@@ -159,9 +162,7 @@ decode (c:cs)
             (acc < 0xd800 || 0xdfff < acc)     &&
             (acc < 0xfffe || 0xffff < acc)      = chr acc : decode rs
           | otherwise = replacement_character : decode rs
-
         aux n (r:rs) acc
           | r .&. 0xc0 == 0x80 = aux (n-1) rs
                                $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)
-
         aux _ rs     _ = replacement_character : decode rs

XMonad/Util/XUtils.hs

@@ -12,19 +12,22 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Util.XUtils  (
-                             -- * Usage:
-                             -- $usage
-                               averagePixels
-                             , createNewWindow
-                             , showWindow
-                             , hideWindow
-                             , deleteWindow
-                             , paintWindow
-                             , paintAndWrite
-                             , stringToPixel
-                            ) where
-
+module XMonad.Util.XUtils
+    ( -- * Usage:
+      -- $usage
+      averagePixels
+    , createNewWindow
+    , showWindow
+    , showWindows
+    , hideWindow
+    , hideWindows
+    , deleteWindow
+    , deleteWindows
+    , paintWindow
+    , paintAndWrite
+    , stringToPixel
+    , fi
+    ) where
 
 import Data.Maybe
 import XMonad
@@ -65,18 +68,30 @@ showWindow w = do
   d <- asks display
   io $ mapWindow d w
 
+-- | the list version
+showWindows :: [Window] -> X ()
+showWindows = mapM_ showWindow
+
 -- | unmap a window
 hideWindow :: Window -> X ()
 hideWindow w = do
   d <- asks display
   io $ unmapWindow d w
 
+-- | the list version
+hideWindows :: [Window] -> X ()
+hideWindows = mapM_ hideWindow
+
 -- | destroy a window
 deleteWindow :: Window -> X ()
 deleteWindow w = do
   d <- asks display
   io $ destroyWindow d w
 
+-- | the list version
+deleteWindows :: [Window] -> X ()
+deleteWindows = mapM_ deleteWindow
+
 -- | Fill a window with a rectangle and a border
 paintWindow :: Window     -- ^ The window where to draw
             -> Dimension  -- ^ Window width
@@ -102,7 +117,8 @@ paintAndWrite :: Window     -- ^ The window where to draw
               -> String     -- ^ String to be printed
               -> X ()
 paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do
-    (x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str
+    d <- asks display
+    (x,y) <- stringPosition d fs (Rectangle 0 0 wh ht) al str
     paintWindow' w (Rectangle x y wh ht) bw bc borc ms
     where ms    = Just (fs,ffc,fbc,str)
 

xmonad-contrib.cabal

@@ -1,5 +1,5 @@
 name:               xmonad-contrib
-version:            0.6
+version:            0.7
 homepage:           http://xmonad.org/
 synopsis:           Third party extensions for xmonad
 description:
@@ -26,6 +26,7 @@ extra-source-files: README scripts/generate-configs scripts/run-xmonad.sh
                     scripts/xmonad-clock.c tests/test_SwapWorkspaces.hs
                     tests/test_XPrompt.hs
 cabal-version:      >= 1.2.1
+build-type:         Simple
 
 flag small_base
   description: Choose the new smaller, split-up base package.
@@ -33,21 +34,30 @@ flag small_base
 flag use_xft
   description: Use Xft to render text
 
+flag with_utf8
+  description: Enable Utf8 support
+
 flag testing
   description: Testing mode
   default: False
 
 library
     if flag(small_base)
-        build-depends: base >= 3, containers, directory, process, random
+        build-depends: base >= 3, containers, directory, process, random, old-time, old-locale
     else
         build-depends: base < 3
 
     if flag(use_xft)
-        build-depends: X11-xft >= 0.2
+        build-depends: X11-xft >= 0.2, utf8-string
+        extensions: ForeignFunctionInterface
         cpp-options: -DXFT
 
-    build-depends:      mtl, unix, X11>=1.4.1, xmonad==0.6
+    if flag(with_utf8)
+        build-depends: utf8-string
+        extensions: ForeignFunctionInterface
+        cpp-options: -DUTF8
+
+    build-depends:      mtl, unix, X11>=1.4.1, xmonad==0.7
     ghc-options:        -Wall
 
     if flag(testing)
@@ -60,6 +70,7 @@ library
                         XMonad.Actions.Commands
                         XMonad.Actions.ConstrainedResize
                         XMonad.Actions.CopyWindow
+                        XMonad.Actions.CycleSelectedLayouts
                         XMonad.Actions.CycleWS
                         XMonad.Actions.DeManage
                         XMonad.Actions.DwmPromote
@@ -70,36 +81,45 @@ library
                         XMonad.Actions.FloatKeys
                         XMonad.Actions.FocusNth
                         XMonad.Actions.MouseGestures
+                        XMonad.Actions.MouseResize
                         XMonad.Actions.NoBorders
+                        XMonad.Actions.PerWorkspaceKeys
+                        XMonad.Actions.Promote
                         XMonad.Actions.RotSlaves
-                        XMonad.Actions.RotView
                         XMonad.Actions.Search
                         XMonad.Actions.SimpleDate
                         XMonad.Actions.SinkAll
                         XMonad.Actions.Submap
                         XMonad.Actions.SwapWorkspaces
                         XMonad.Actions.TagWindows
+                        XMonad.Actions.UpdatePointer
                         XMonad.Actions.Warp
+                        XMonad.Actions.WindowGo
                         XMonad.Actions.WindowBringer
-                        XMonad.Actions.WmiiActions
                         XMonad.Config.Sjanssen
                         XMonad.Config.Dons
                         XMonad.Config.Arossato
                         XMonad.Config.Droundy
                         XMonad.Hooks.DynamicLog
+                        XMonad.Hooks.EventHook
                         XMonad.Hooks.EwmhDesktops
                         XMonad.Hooks.ManageDocks
                         XMonad.Hooks.ManageHelpers
                         XMonad.Hooks.SetWMName
+                        XMonad.Hooks.ServerMode
                         XMonad.Hooks.UrgencyHook
                         XMonad.Hooks.XPropManage
                         XMonad.Layout.Accordion
                         XMonad.Layout.Circle
                         XMonad.Layout.Combo
+                        XMonad.Layout.Decoration
+                        XMonad.Layout.DecorationMadness
                         XMonad.Layout.Dishes
                         XMonad.Layout.DragPane
+                        XMonad.Layout.DwmStyle
                         XMonad.Layout.Grid
                         XMonad.Layout.HintedTile
+                        XMonad.Layout.IM
                         XMonad.Layout.LayoutCombinators
                         XMonad.Layout.LayoutHints
                         XMonad.Layout.LayoutModifier
@@ -107,7 +127,6 @@ library
                         XMonad.Layout.MagicFocus
                         XMonad.Layout.Magnifier
                         XMonad.Layout.Maximize
-                        XMonad.Layout.Mosaic
                         XMonad.Layout.MosaicAlt
                         XMonad.Layout.MultiToggle
                         XMonad.Layout.Named
@@ -115,38 +134,51 @@ library
                         XMonad.Layout.PerWorkspace
                         XMonad.Layout.Reflect
                         XMonad.Layout.ResizableTile
+                        XMonad.Layout.ResizeScreen
                         XMonad.Layout.Roledex
+                        XMonad.Layout.ScratchWorkspace
+                        XMonad.Layout.Simplest
+                        XMonad.Layout.SimpleDecoration
+                        XMonad.Layout.SimpleFloat
                         XMonad.Layout.Spiral
                         XMonad.Layout.Square
                         XMonad.Layout.ShowWName
                         XMonad.Layout.Tabbed
+                        XMonad.Layout.TabBarDecoration
                         XMonad.Layout.ThreeColumns
                         XMonad.Layout.ToggleLayouts
                         XMonad.Layout.TwoPane
+                        XMonad.Layout.WindowArranger
                         XMonad.Layout.WindowNavigation
                         XMonad.Layout.WorkspaceDir
                         XMonad.Prompt.Directory
                         XMonad.Prompt
-                        XMonad.Prompt.Layout
-                        XMonad.Prompt.Man
-                        XMonad.Prompt.Shell
-                        XMonad.Prompt.Ssh
-                        XMonad.Prompt.Window
-                        XMonad.Prompt.Workspace
-                        XMonad.Prompt.XMonad
                         XMonad.Prompt.AppendFile
                         XMonad.Prompt.Input
                         XMonad.Prompt.Email
-                        XMonad.Util.Anneal
+                        XMonad.Prompt.Layout
+                        XMonad.Prompt.Man
+                        XMonad.Prompt.DirExec
+                        XMonad.Prompt.RunOrRaise
+                        XMonad.Prompt.Shell
+                        XMonad.Prompt.Ssh
+                        XMonad.Prompt.Theme
+                        XMonad.Prompt.Window
+                        XMonad.Prompt.Workspace
+                        XMonad.Prompt.XMonad
                         XMonad.Util.CustomKeys
                         XMonad.Util.Dmenu
                         XMonad.Util.Dzen
                         XMonad.Util.EZConfig
                         XMonad.Util.Font
                         XMonad.Util.Invisible
+                        XMonad.Util.Loggers
                         XMonad.Util.NamedWindows
                         XMonad.Util.Run
+                        XMonad.Util.Scratchpad
+                        XMonad.Util.Themes
                         XMonad.Util.Timer
+                        XMonad.Util.WindowProperties
                         XMonad.Util.WorkspaceCompare
                         XMonad.Util.XSelection
                         XMonad.Util.XUtils