Bump version to 0.7

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

Anneal.hs

@@ -1,90 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.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 XMonadContrib.Anneal ( 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 )
-
--- %import XMonadContrib.Anneal
-
-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

Combo.hs

@@ -1,96 +0,0 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Combo
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout that combines multiple layouts.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Combo (
-                            -- * Usage
-                            -- $usage 
-                            combo
-                           ) where
-
-import Control.Arrow ( first )
-import Data.List ( delete )
-import Data.Maybe ( isJust )
-import XMonad
-import StackSet ( integrate, Stack(..) )
-import qualified StackSet as W ( differentiate )
-
--- $usage
---
--- To use this layout write, in your Config.hs:
--- 
--- > import XMonadContrib.Combo 
--- 
--- and add something like
--- 
--- > combo (TwoPane 0.03 0.5) [(Full,1),(tabbed shrinkText defaultTConf,1)]
---
--- to your layouts.
---
--- The first argument to combo is a layout that will divide the screen into
--- one or more subscreens.  The second argument is a list of layouts which
--- will be used to lay out the contents of each of those subscreens.
--- Paired with each of these layouts is an integer giving the number of
--- windows this section should hold.  This number is ignored for the last
--- layout, which will hold any excess windows.
-
--- %import XMonadContrib.Combo
--- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)]
-
-combo :: (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
-         => (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a
-combo = Combo []
-
-data Combo l a = Combo [a] (l (Layout a, Int)) [(Layout a, Int)]
-                 deriving (Show, Read)
-
-instance (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
-    => LayoutClass (Combo l) a where
-    doLayout (Combo f super origls) rinput s = arrange (integrate s)
-        where arrange [] = return ([], Just $ Combo [] super origls)
-              arrange [w] = return ([(w,rinput)], Just $ Combo [w] super origls)
-              arrange origws =
-                do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls)
-                   let super' = maybe super id msuper'
-                       f' = focus s:delete (focus s) f
-                       lwrs [] _ = []
-                       lwrs [((l,_),r)] ws = [((l,r),differentiate f' ws)]
-                       lwrs (((l,n),r):xs) ws = ((l,r),differentiate f' $ take len1 ws) : lwrs xs (drop len1 ws)
-                           where len1 = min n (length ws - length xs)
-                   out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws
-                   let origls' = zipWith foo (out++repeat ([],Nothing)) origls
-                       foo (_, Nothing) x = x
-                       foo (_, Just l') (_, n) = (l', n)
-                   return (concat $ map fst out, Just $ Combo f' super' origls')
-              differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
-              differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z
-                                                                   , up = reverse $ takeWhile (/=z) xs
-                                                                   , down = tail $ dropWhile (/=z) xs }
-                                      | otherwise = differentiate zs xs
-              differentiate [] xs = W.differentiate xs
-    handleMessage (Combo f super origls) m =
-                      do mls <- broadcastPrivate m (map fst origls)
-                         let mls' = (\x->zipWith first (map const x) origls) `fmap` mls
-                         msuper <- broadcastPrivate m [super]
-                         case msuper of
-                           Just [super'] -> return $ Just $ Combo f super' $ maybe origls id mls'
-                           _ -> return $ Combo f super `fmap` mls'
-
-broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
-broadcastPrivate a ol = do nml <- mapM f ol
-                           if any isJust nml
-                              then return $ Just $ zipWith ((flip maybe) id) ol nml
-                              else return Nothing
-    where f l = handleMessage l a `catchX` return Nothing

Commands.hs

@@ -1,110 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Commands
--- Copyright   :  (c) David Glasser 2007
--- License     :  BSD3
--- 
--- Maintainer  :  glasser@mit.edu
--- Stability   :  stable
--- Portability :  portable
---
--- Allows you to run internal xmonad commands (X () actions) using
--- a dmenu menu in addition to key bindings.  Requires dmenu and
--- the Dmenu XMonadContrib module.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Commands (
-                             -- * Usage
-                             -- $usage
-                             commandMap,
-                             runCommand,
-                             runCommand',
-                             workspaceCommands,
-                             screenCommands,
-                             defaultCommands
-                              ) where
-
-import XMonad
-import Operations
-import StackSet hiding (workspaces)
-import XMonadContrib.Dmenu (dmenu)
-import {-# SOURCE #-} Config (workspaces,serialisedLayouts)
-
-import qualified Data.Map as M
-import System.Exit
-import Data.Maybe
-
--- $usage
---
--- To use, modify your Config.hs to:
---
--- >    import XMonadContrib.Commands
---
--- and add a keybinding to the runCommand action:
---
--- >    , ((modMask .|. controlMask, xK_y), runCommand commands)
---
--- and define the list commands:
---
--- >    commands :: [(String, X ())]
--- >    commands = defaultCommands
---
--- A popup menu of internal xmonad commands will appear.  You can
--- change the commands by changing the contents of the list
--- 'commands'.  (If you like it enough, you may even want to get rid
--- of many of your other key bindings!)
-
--- %def commands :: [(String, X ())]
--- %def commands = defaultCommands
--- %import XMonadContrib.Commands
--- %keybind , ((modMask .|. controlMask, xK_y), runCommand commands)
-
-commandMap :: [(String, X ())] -> M.Map String (X ())
-commandMap c = M.fromList c
-
-workspaceCommands :: [(String, X ())]
-workspaceCommands = [((m ++ show i), windows $ f i)
-                         | i <- workspaces
-                         , (f, m) <- [(view, "view"), (shift, "shift")]
-                    ]
-
-screenCommands :: [(String, X ())]
-screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
-                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
-                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]
-                 ]
-
-defaultCommands :: [(String, X ())]
-defaultCommands = workspaceCommands ++ screenCommands
-                  ++ [ ("shrink"              , sendMessage Shrink                               )
-                     , ("expand"              , sendMessage Expand                               )
-                     , ("next-layout"         , sendMessage NextLayout                           )
-                     , ("previous-layout"     , sendMessage PrevLayout                           )
-                     , ("default-layout"      , setLayout (head serialisedLayouts)                 )
-                     , ("restart-wm"          , sr >> restart Nothing True                       )
-                     , ("restart-wm-no-resume", sr >> restart Nothing False                      )
-                     , ("xterm"               , spawn "xterm"                                    )
-                     , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )
-                     , ("kill"                , kill                                             )
-                     , ("refresh"             , refresh                                          )
-                     , ("focus-up"            , windows $ focusUp                                )
-                     , ("focus-down"          , windows $ focusDown                              )
-                     , ("swap-up"             , windows $ swapUp                                 )
-                     , ("swap-down"           , windows $ swapDown                               )
-                     , ("swap-master"         , windows $ swapMaster                             )
-                     , ("sink"                , withFocused $ windows . sink                     )
-                     , ("quit-wm"             , io $ exitWith ExitSuccess                        )
-                     ]
-    where sr = broadcastMessage ReleaseResources
-
-runCommand :: [(String, X ())] -> X ()
-runCommand cl = do
-  let m = commandMap cl
-  choice <- dmenu (M.keys m)
-  fromMaybe (return ()) (M.lookup choice m)
-
-runCommand' :: String -> X ()
-runCommand' c = do
-  let m = commandMap defaultCommands
-  fromMaybe (return ()) (M.lookup c m)

CopyWindow.hs

@@ -1,79 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.CopyWindow
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides a binding to duplicate a window on multiple workspaces,
--- providing dwm-like tagging functionality.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.CopyWindow (
-                                 -- * Usage
-                                 -- $usage
-                                 copy, kill1
-                                ) where
-
-import Prelude hiding ( filter )
-import Control.Monad.State ( gets )
-import qualified Data.List as L
-import XMonad
-import Operations ( windows, kill )
-import StackSet
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.CopyWindow
---
--- > -- mod-[1..9] @@ Switch to workspace N
--- > -- mod-shift-[1..9] @@ Move client to workspace N
--- > -- mod-control-shift-[1..9] @@ Copy client to workspace N
--- > [((m .|. modMask, k), f i)
--- >     | (i, k) <- zip workspaces [xK_1 ..]
--- >     , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]
---
--- you may also wish to redefine the binding to kill a window so it only
--- removes it from the current workspace, if it's present elsewhere:
---
--- >  , ((modMask .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
-
--- %import XMonadContrib.CopyWindow
--- %keybind -- comment out default close window binding above if you uncomment this:
--- %keybind , ((modMask .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
--- %keybindlist ++
--- %keybindlist -- mod-[1..9] @@ Switch to workspace N
--- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N
--- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N
--- %keybindlist [((m .|. modMask, k), f i)
--- %keybindlist     | (i, k) <- zip workspaces [xK_1 ..]
--- %keybindlist     , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]
-
--- | copy. Copy a window to a new workspace.
-copy :: WorkspaceId -> WindowSet -> WindowSet
-copy n = copy'
-    where copy' s = if n `tagMember` s && n /= tag (workspace (current s))
-                    then maybe s (go s) (peek s)
-                    else s
-          go s w = view (tag (workspace (current s))) $ insertUp' w $ view n s
-          insertUp' a s = modify (Just $ Stack a [] [])
-                          (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s
-
--- | Remove the focussed window from this workspace.  If it's present in no
--- other workspace, then kill it instead. If we do kill it, we'll get a
--- delete notify back from X.
---
--- There are two ways to delete a window. Either just kill it, or if it
--- supports the delete protocol, send a delete event (e.g. firefox)
---
-kill1 :: X ()
-kill1 = do ss <- gets windowset
-           whenJust (peek ss) $ \w -> if member w $ delete'' w ss
-                                      then windows $ delete'' w
-                                      else kill
-    where delete'' w = modify Nothing (filter (/= w))

CycleWS.hs

@@ -1,99 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.CycleWS
--- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides bindings to cycle forward or backward through the list
--- of workspaces, and to move windows there.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.CycleWS (
-                              -- * Usage
-                              -- $usage
-                              nextWS,
-                              prevWS,
-			      shiftToNext,
-			      shiftToPrev,
-                             ) where
-
-import Control.Monad.State ( gets )
-import Data.List ( sortBy, findIndex )
-import Data.Maybe ( fromMaybe )
-import Data.Ord ( comparing )
-
-import XMonad
-import StackSet hiding (filter, findIndex)
-import Operations
-import {-# SOURCE #-} qualified Config (workspaces)
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.CycleWS
---
--- >   , ((modMask,               xK_Right), nextWS)
--- >   , ((modMask,               xK_Left),  prevWS)
--- >   , ((modMask .|. shiftMask, xK_Right), shiftToNext)
--- >   , ((modMask .|. shiftMask, xK_Left),  shiftToPrev)
---
--- If you want to follow the moved window, you can use both actions:
---
--- >   , ((modMask .|. shiftMask, xK_Right), shiftToNext >> nextWS)
--- >   , ((modMask .|. shiftMask, xK_Left),  shiftToPrev >> prevWS)
---
-
--- %import XMonadContrib.CycleWS
--- %keybind , ((modMask,               xK_Right), nextWS)
--- %keybind , ((modMask,               xK_Left),  prevWS)
--- %keybind , ((modMask .|. shiftMask, xK_Right), shiftToNext)
--- %keybind , ((modMask .|. shiftMask, xK_Left),  shiftToPrev)
-
-
--- ---------------------
--- |
--- Switch to next workspace
-nextWS :: X()
-nextWS = switchWorkspace (1)
-
--- ---------------------
--- |
--- Switch to previous workspace
-prevWS :: X()
-prevWS = switchWorkspace (-1)
-
--- |
--- Move focused window to next workspace
-shiftToNext :: X()
-shiftToNext = shiftBy (1)
-
--- |
--- Move focused window to previous workspace
-shiftToPrev :: X ()
-shiftToPrev = shiftBy (-1)
-
-switchWorkspace :: Int -> X ()
-switchWorkspace d = wsBy d >>= windows . greedyView
-
-shiftBy :: Int -> X ()
-shiftBy d = wsBy d >>= windows . shift
-
-wsBy :: Int -> X (WorkspaceId)
-wsBy d = do
-    ws <- gets windowset
-    let orderedWs = sortBy (comparing wsIndex) (workspaces ws)
-    let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs
-    let next = orderedWs !! ((now + d) `mod` length orderedWs)
-    return $ tag next
-
-
-wsIndex :: WindowSpace -> Maybe Int
-wsIndex ws = findIndex (==(tag ws)) Config.workspaces
-
-findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
-findWsIndex ws wss = findIndex ((== tag ws) . tag) wss

Dishes.hs

@@ -1,57 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Dishes
--- Copyright   :  (c) Jeremy Apthorp
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  Jeremy Apthorp <nornagon@gmail.com>
--- Stability   :  unstable
--- Portability :  portable
---
--- Dishes is a layout that stacks extra windows underneath the master
--- windows.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Dishes (
-                              -- * Usage
-															-- $usage
-                              Dishes (..)
-                            ) where
-
-import Data.List
-import XMonad
-import Operations
-import StackSet (integrate)
-import Control.Monad (ap)
-import Graphics.X11.Xlib
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.Dishes
---
--- and add the following line to your 'layouts'
---
--- > , Layout $ Dishes 2 (1%6)
-
--- %import XMonadContrib.Dishes
--- %layout , Layout $ Dishes 2 (1%6)
-
-data Dishes a = Dishes Int Rational deriving (Show, Read)
-instance LayoutClass Dishes a where
-	doLayout (Dishes nmaster h) r =
-		return . (\x->(x,Nothing)) .
-		ap zip (dishes h r nmaster . length) . integrate
-	pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m)
-		where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h
-
-dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
-dishes h s nmaster n = if n <= nmaster
-		then splitHorizontally n s
-		else ws
-	where
-		(m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s
-		ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest

DynamicLog.hs

@@ -1,160 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DynamicLog
--- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>
--- Stability   :  unstable
--- Portability :  unportable
---
--- DynamicLog
---
--- Log events in:
---
--- >     1 2 [3] 4 8
---
--- format. Suitable to pipe into dzen.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DynamicLog (
-    -- * Usage
-    -- $usage 
-    dynamicLog,
-    dynamicLogWithTitle,
-    dynamicLogWithTitleColored,
-    dynamicLogXinerama,
-
-    pprWindowSet,
-    pprWindowSetXinerama
-  ) where
-
--- 
--- Useful imports
---
-import XMonad
-import {-# SOURCE #-} Config (workspaces)
-import Operations () -- for ReadableSomeLayout instance
-import Data.Maybe ( isJust )
-import Data.List
-import Data.Ord ( comparing )
-import qualified StackSet as S
-import Data.Monoid
-import XMonadContrib.NamedWindows
-import Data.Char
-
--- $usage 
---
--- To use, set:
---
--- >    import XMonadContrib.DynamicLog
--- >    logHook = dynamicLog
---
--- To get the title of the currently focused window after the workspace list:
---
--- >    import XMonadContrib.DynamicLog
--- >    logHook = dynamicLogWithTitle
---
--- To have the window title highlighted in any color recognized by dzen:
---
--- >    import XMonadContrib.DynamicLog
--- >    logHook = dynamicLogWithTitleColored "white"
---
-
--- %import XMonadContrib.DynamicLog
--- %def -- comment out default logHook definition above if you uncomment any of these:
--- %def logHook = dynamicLog
--- %def logHook = dynamicLogWithTitle
--- %def logHook = dynamicLogWithTitleColored "white"
-
-
--- |
--- Perform an arbitrary action on each state change.
--- Examples include:
---      * do nothing
---      * log the state to stdout
---
--- | 
--- An example log hook, print a status bar output to dzen, in the form:
---
--- > 1 2 [3] 4 7 : full
---
--- That is, the currently populated workspaces, and the current
--- workspace layout
---  
-dynamicLog :: X ()
-dynamicLog = withWindowSet $ \ws -> do
-    let ld = description . S.layout . S.workspace . S.current $ ws
-        wn = pprWindowSet ws
-    io . putStrLn $ concat [wn ," : " ,map toLower ld]
-
--- | Appends title of currently focused window to log output, and the
--- current layout mode, to the normal dynamic log format.
--- Arguments are: pre-title text and post-title text
---
--- The result is rendered in the form:
---
--- > 1 2 [3] 4 7 : full : urxvt
---
-dynamicLogWithTitle_ :: String -> String -> X ()
-dynamicLogWithTitle_ pre post= do
-    -- layout description
-    ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current
-    -- workspace list
-    ws <- withWindowSet $ return . pprWindowSet
-    -- window title
-    wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek
-
-    io . putStrLn $ concat [ws ," : " ,map toLower ld
-                           , case wt of
-                                   [] -> []
-                                   s  -> " : " ++ pre ++ s ++ post
-                           ]
-
-dynamicLogWithTitle :: X ()
-dynamicLogWithTitle = dynamicLogWithTitle_ "" ""
-
--- | 
--- As for dynamicLogWithTitle but with colored window title (for dzen use)
---
-dynamicLogWithTitleColored :: String -> X ()
-dynamicLogWithTitleColored color = dynamicLogWithTitle_ ("^fg(" ++ color ++ ")") "^fg()"
-
-pprWindowSet :: WindowSet -> String
-pprWindowSet s =  concatMap fmt $ sortBy cmp
-            (map S.workspace (S.current s : S.visible s) ++ S.hidden s)
-   where f Nothing Nothing   = EQ
-         f (Just _) Nothing  = LT
-         f Nothing (Just _)  = GT
-         f (Just x) (Just y) = compare x y
-
-         wsIndex = flip elemIndex workspaces . S.tag
-
-         cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b)
-
-         this     = S.tag (S.workspace (S.current s))
-         visibles = map (S.tag . S.workspace) (S.visible s)
-
-         fmt w | S.tag w == this         = "[" ++ S.tag w ++ "]"
-               | S.tag w `elem` visibles = "<" ++ S.tag w ++ ">"
-               | isJust (S.stack w)      = " " ++ S.tag w ++ " "
-               | otherwise               = ""
-
--- |
--- Workspace logger with a format designed for Xinerama:
---
--- > [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
---
-dynamicLogXinerama :: X ()
-dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
-
-pprWindowSetXinerama :: WindowSet -> String
-pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
-  where onscreen  = map (S.tag . S.workspace)
-                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws
-        offscreen = map S.tag . filter (isJust . S.stack)
-                        . sortBy (comparing S.tag) $ S.hidden ws

DynamicWorkspaces.hs

@@ -1,69 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DynamicWorkspaces
--- 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 add and delete workspaces.  Note that you may only
--- delete a workspace that is already empty.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DynamicWorkspaces (
-                                         -- * Usage
-                                         -- $usage
-                                         addWorkspace, removeWorkspace
-                                       ) where
-
-import Control.Monad.State ( gets )
-
-import XMonad ( X, XState(..), Layout, WorkspaceId )
-import Operations
-import StackSet hiding (filter, modify, delete)
-import Graphics.X11.Xlib ( Window )
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.DynamicWorkspaces
---
--- >   , ((modMask .|. shiftMask, xK_Up), addWorkspace layouts)
--- >   , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
-
-allPossibleTags :: [WorkspaceId]
-allPossibleTags = map (:"") ['0'..]
-
-addWorkspace :: Layout Window -> X ()
-addWorkspace l = do s <- gets windowset
-                    let newtag:_ = filter (not . (`tagMember` s)) allPossibleTags
-                    windows (addWorkspace' newtag l)
-
-removeWorkspace :: X ()
-removeWorkspace = do s <- gets windowset
-                     case s of
-                       StackSet { current = Screen { workspace = torem }
-                                , hidden = (w:_) }
-                           -> do windows $ view (tag w)
-                                 windows (removeWorkspace' (tag torem))
-                       _ -> return ()
-
-addWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
-addWorkspace' newtag l s@(StackSet { current = scr@(Screen { workspace = w })
-                                   , hidden = ws })
-    = s { current = scr { workspace = Workspace newtag l Nothing }
-        , hidden = w:ws }
-
-removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
-removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
-                                   , hidden = (w:ws) })
-    | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
-                         , hidden = ws }
-   where meld Nothing Nothing = Nothing
-         meld x Nothing = x
-         meld Nothing x = x
-         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
-removeWorkspace' _ s = s

Dzen.hs

@@ -1,63 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Dzen
--- Copyright   :  (c) glasser@mit.edu
--- License     :  BSD
---
--- Maintainer  :  glasser@mit.edu
--- Stability   :  unstable
--- Portability :  unportable
---
--- Handy wrapper for dzen.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Dzen (dzen, dzenScreen) where
-
-import System.Posix.Process (forkProcess, getProcessStatus, createSession)
-import System.IO
-import System.Process
-import System.Exit
-import Control.Concurrent (threadDelay)
-import Control.Monad.State
-
-import qualified StackSet as W
-import XMonad
-
--- wait is in us
-runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()
-runProcessWithInputAndWait cmd args input timeout = do
-    pid <- forkProcess $ do
-       forkProcess $ do -- double fork it over to init
-         createSession
-         (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
-         hPutStr pin input
-         hFlush pin
-         threadDelay timeout
-         hClose pin
-         --     output <- hGetContents pout
-         --     when (output==output) $ return ()
-         hClose pout
-         hClose perr
-         waitForProcess ph
-         return ()
-       exitWith ExitSuccess
-       return ()
-    getProcessStatus True False pid
-    return ()
-
-
-curScreen :: X ScreenId
-curScreen =  (W.screen . W.current) `liftM` gets windowset
-
-toXineramaArg :: ScreenId -> String
-toXineramaArg n = show ( ((fromIntegral n)+1)::Int )
-
--- Requires dzen >= 0.2.4.
-
-dzen :: String -> X ()
-dzen str = curScreen >>= \sc -> dzenScreen sc str
-
-dzenScreen :: ScreenId -> String -> X()
-dzenScreen sc str = io $ (runProcessWithInputAndWait "dzen2" ["-xs", screen] str 5000000)
-    where screen = toXineramaArg sc

EwmhDesktops.hs

@@ -1,130 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.EwmhDesktops
--- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
--- License      : BSD
---
--- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
--- Stability    : unstable
--- Portability  : unportable
---
--- Makes xmonad use the EWMH hints to tell panel applications about its
--- workspaces and the windows therein.
------------------------------------------------------------------------------
-module XMonadContrib.EwmhDesktops (
-    -- * Usage
-    -- $usage
-    ewmhDesktopsLogHook
-    ) where
-
-import Data.List    (elemIndex, sortBy)
-import Data.Ord     (comparing)
-import Data.Maybe   (fromMaybe)
-
-import Control.Monad.Reader
-import XMonad
-import qualified StackSet as W
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
-import XMonadContrib.SetWMName
-
--- $usage
--- Add the imports to your configuration file and add the logHook:
---
--- > import XMonadContrib.EwmhDesktops
---
--- > logHook :: X()
--- > logHook = do ewmhDesktopsLogHook
--- >              return ()
-
--- %import XMonadContrib.EwmhDesktops
--- %def -- comment out default logHook definition above if you uncomment this:
--- %def logHook = ewmhDesktopsLogHook
-
-
--- |
--- Notifies pagers and window lists, such as those in the gnome-panel
--- of the current state of workspaces and windows.
-ewmhDesktopsLogHook :: X ()
-ewmhDesktopsLogHook = withWindowSet $ \s -> do
-    -- Bad hack because xmonad forgets the original order of things, it seems
-    -- see http://code.google.com/p/xmonad/issues/detail?id=53
-    let ws = sortBy (comparing W.tag) $ W.workspaces s
-    let wins = W.allWindows s
-
-    setSupported
-
-    -- Number of Workspaces
-    setNumberOfDesktops (length ws)
-
-    -- Names thereof
-    setDesktopNames (map W.tag ws)
-
-    -- Current desktop
-    fromMaybe (return ()) $ do
-        n <- W.lookupWorkspace 0 s
-        i <- elemIndex n $ map W.tag ws
-        return $ setCurrentDesktop i
-
-    setClientList wins
-
-    -- Per window Desktop
-    forM (zip ws [(0::Int)..]) $ \(w, wn) ->
-        forM (W.integrate' (W.stack w)) $ \win -> do
-            setWindowDesktop win wn
-
-    return ()
-
-
-setNumberOfDesktops :: (Integral a) => a -> X ()
-setNumberOfDesktops n = withDisplay $ \dpy -> do
-    a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
-    c <- getAtom "CARDINAL"
-    r <- asks theRoot
-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]
-
-setCurrentDesktop :: (Integral a) => a -> X ()
-setCurrentDesktop i = withDisplay $ \dpy -> do
-    a <- getAtom "_NET_CURRENT_DESKTOP"
-    c <- getAtom "CARDINAL"
-    r <- asks theRoot
-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]
-
-setDesktopNames :: [String] -> X ()
-setDesktopNames names = withDisplay $ \dpy -> do
-    -- Names thereof
-    r <- asks theRoot
-    a <- getAtom "_NET_DESKTOP_NAMES"
-    c <- getAtom "UTF8_STRING"
-    let names' = map (fromIntegral.fromEnum) $
-            concatMap (("Workspace "++) . (++['\0'])) names
-    io $ changeProperty8 dpy r a c propModeReplace names'
-
-setClientList :: [Window] -> X ()
-setClientList wins = withDisplay $ \dpy -> do
-    -- (What order do we really need? Something about age and stacking)
-    r <- asks theRoot
-    c <- getAtom "WINDOW"
-    a <- getAtom "_NET_CLIENT_LIST"
-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)
-    a' <- getAtom "_NET_CLIENT_LIST_STACKING"
-    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
-
-setWindowDesktop :: (Integral a) => Window -> a -> X ()
-setWindowDesktop win i = withDisplay $ \dpy -> do
-    a <- getAtom "_NET_WM_DESKTOP"
-    c <- getAtom "CARDINAL"
-    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]
-
-setSupported :: X ()
-setSupported = withDisplay $ \dpy -> do
-    r <- asks theRoot
-    a <- getAtom "_NET_SUPPORTED"
-    c <- getAtom "ATOM"
-    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]
-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
-
-    setWMName "xmonad"
-
-

Grid.hs

@@ -1,65 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Grid
--- Copyright   :  (c) Lukas Mai
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  <l.mai@web.de>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A simple layout that attempts to put all windows in a square grid.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Grid (
-    -- * Usage
-    -- $usage
-	Grid(..)
-) where
-
-import XMonad
-import StackSet
-import Graphics.X11.Xlib.Types
-
--- $usage
--- Put the following in your Config.hs file:
---
--- > import XMonadContrib.Grid
--- > ...
--- > layouts = [ ...
--- >                  , Layout Grid
--- >                  ]
-
--- %import XMonadContrib.Grid
--- %layout , Layout Grid
-
-data Grid a = Grid deriving (Read, Show)
-
-instance LayoutClass Grid a where
-    pureLayout Grid r s = arrange r (integrate s)
-
-arrange :: Rectangle -> [a] -> [(a, Rectangle)]
-arrange (Rectangle rx ry rw rh) st = zip st rectangles
-	where
-	nwins = length st
-	ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins
-	mincs = nwins `div` ncols
-	extrs = nwins - ncols * mincs
-	chop :: Int -> Dimension -> [(Position, Dimension)]
-	chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
-		where
-		k :: Dimension
-		k = m `div` fromIntegral n
-		m' = fromIntegral m
-		k' :: Position
-		k' = fromIntegral k
-	xcoords = chop ncols rw
-	ycoords = chop mincs rh
-	ycoords' = chop (succ mincs) rh
-	(xbase, xext) = splitAt (ncols - extrs) xcoords
-	rectangles = combine ycoords xbase ++ combine ycoords' xext
-		where
-		combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]

HintedTile.hs

@@ -1,98 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.HintedTile
--- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A gapless tiled layout that attempts to obey window size hints, 
--- rather than simply ignoring them.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.HintedTile (
-                                 -- * Usage
-                                 -- $usage
-                                 tall, wide) where
-
-import XMonad
-import Operations (Resize(..), IncMasterN(..), applySizeHints)
-import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Control.Monad
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import qualified XMonadContrib.HintedTile
---
--- > layouts = [ XMonadContrib.HintedTile.tall nmaster delta ratio, ... ]
-
--- %import qualified XMonadContrib.HintedTile
---
--- %layout , XMonadContrib.HintedTile.tall nmaster delta ratio
-
--- this sucks
-addBorder, substractBorder :: (Dimension, Dimension) -> (Dimension, Dimension)
-addBorder (w, h) = (w + 2 * borderWidth, h + 2 * borderWidth)
-substractBorder (w, h) = (w - 2 * borderWidth, h - 2 * borderWidth)
-
-
-tall, wide :: Int -> Rational -> Rational -> Layout Window
-wide = tile splitVertically divideHorizontally
-tall = tile splitHorizontally divideVertically
-
-tile split divide nmaster delta frac =
-    Layout { doLayout     = \r w' -> let w = W.integrate w'
-                                     in do { hints <- sequence (map getHints w)
-                                           ; return (zip w (tiler frac r `uncurry` splitAt nmaster hints)
-                                                    , Nothing) }
-           , modifyLayout = \m -> return $ fmap resize     (fromMessage m) `mplus`
-                                           fmap incmastern (fromMessage m) }
-
-    where resize Shrink = tile split divide nmaster delta (frac-delta)
-          resize Expand = tile split divide nmaster delta (frac+delta)
-          incmastern (IncMasterN d) = tile split divide (max 0 (nmaster+d)) delta frac
-
-          tiler f r masters slaves = if null masters || null slaves
-              then divide (masters ++ slaves) r
-              else split f r (divide masters) (divide slaves)
-
-getHints :: Window -> X SizeHints
-getHints w = withDisplay $ \d -> io $ getWMNormalHints d w
-
---
--- Divide the screen vertically (horizontally) into n subrectangles
---
-divideVertically, divideHorizontally :: [SizeHints] -> Rectangle -> [Rectangle]
-divideVertically [] _ = [] -- there's a fold here, struggling to get out
-divideVertically (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divideVertically rest (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
-    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
-                   (sw, sh `div` fromIntegral (1 + (length rest)))
-
-divideHorizontally [] _ = []
-divideHorizontally (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divideHorizontally rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
-    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
-                   (sw `div` fromIntegral (1 + (length rest)), sh)
-
-
--- Split the screen into two rectangles, using a rational to specify the ratio
-splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle]
-splitHorizontally f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects
-    where leftw = floor $ fromIntegral sw * f
-          leftRects = left $ Rectangle sx sy leftw sh
-          rightx = (maximum . map rect_width) leftRects
-          rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh
-
-splitVertically f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects
-    where toph = floor $ fromIntegral sh * f
-          topRects = top $ Rectangle sx sy sw toph
-          bottomy = (maximum . map rect_height) topRects
-          bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)

LayoutHints.hs

@@ -1,57 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHints
--- Copyright    : (c) David Roundy <droundy@darcs.net>
--- License      : BSD
---
--- Maintainer   : David Roundy <droundy@darcs.net>
--- Stability    : unstable
--- Portability  : portable
---
--- Make layouts respect size hints.
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutHints (
-    -- * usage
-    -- $usage
-    layoutHints,
-    LayoutHints) where
-
-import Operations ( applySizeHints, D )
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras ( getWMNormalHints )
-import {-#SOURCE#-} Config (borderWidth)
-import XMonad hiding ( trace )
-import XMonadContrib.LayoutModifier
-
--- $usage
--- > import XMonadContrib.LayoutHints
--- > layouts = [ layoutHints tiled , layoutHints $ Mirror tiled ]
-
--- %import XMonadContrib.LayoutHints
--- %layout , layoutHints $ tiled
--- %layout , layoutHints $ Mirror tiled
-
-layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
-layoutHints = ModifiedLayout LayoutHints
-
--- | Expand a size by the given multiple of the border width.  The
--- multiple is most commonly 1 or -1.
-adjBorders             :: Dimension -> D -> D
-adjBorders mult (w,h)  = (w+2*mult*borderWidth, h+2*mult*borderWidth)
-
-data LayoutHints a = LayoutHints deriving (Read, Show)
-
-instance LayoutModifier LayoutHints Window where
-    modifierDescription _ = "Hinted"
-    redoLayout _ _ _ xs = do
-                            xs' <- mapM applyHint xs
-                            return (xs', Nothing)
-     where
-        applyHint (w,Rectangle a b c d) =
-            withDisplay $ \disp -> do
-                sh <- io $ getWMNormalHints disp w
-                let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d)
-                return (w, Rectangle a b c' d')

LayoutModifier.hs

@@ -1,63 +0,0 @@
-{-# -fglasgow-exts #-} -- For deriving Data/Typeable
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
-
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutModifier
--- Copyright    : (c) David Roundy <droundy@darcs.net>
--- License      : BSD
---
--- Maintainer   : David Roundy <droundy@darcs.net>
--- Stability    : unstable
--- Portability  : portable
---
--- A module for writing easy Layouts
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutModifier (
-    -- * Usage
-    -- $usage
-    LayoutModifier(..), ModifiedLayout(..)
-    ) where
-
-import Graphics.X11.Xlib ( Rectangle )
-import XMonad
-import StackSet ( Stack )
-import Operations ( LayoutMessages(Hide, ReleaseResources) )
-
--- $usage
--- Use LayoutHelpers to help write easy Layouts.
-
-class (Show (m a), Read (m a)) => LayoutModifier m a where
-    handleMess :: m a -> SomeMessage -> X (Maybe (m a))
-    handleMess m mess | Just Hide <- fromMessage mess             = doUnhook
-                        | Just ReleaseResources <- fromMessage mess = doUnhook
-                        | otherwise = return Nothing
-     where doUnhook = do unhook m; return Nothing
-    redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
-               -> X ([(a, Rectangle)], Maybe (m a))
-    redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)
-    hook :: m a -> X ()
-    hook _ = return ()
-    unhook :: m a -> X ()
-    unhook _ = return ()
-    modifierDescription :: m a -> String
-    modifierDescription = show
-
-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
-           let ml'' = case mm' of
-                      Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
-                      Nothing -> ModifiedLayout m `fmap` ml'
-           return (ws', ml'')
-    handleMessage (ModifiedLayout m l) mess =
-        do ml' <- handleMessage l mess
-           mm' <- handleMess m mess
-           return $ case mm' of
-                    Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
-                    Nothing -> (ModifiedLayout m) `fmap` ml'
-    description (ModifiedLayout m l) = modifierDescription m ++ " " ++ description l
-
-data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )

MagicFocus.hs

@@ -1,51 +0,0 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.MagicFocus
--- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>
--- License      : BSD
---
--- Maintainer   : Peter De Wachter <pdewacht@gmail.com>
--- Stability    : unstable
--- Portability  : unportable
---
--- Automagically put the focused window in the master area.
------------------------------------------------------------------------------
-
-module XMonadContrib.MagicFocus 
-    (-- * Usage
-     -- $usage
-     MagicFocus(MagicFocus)
-    ) where
-
-import Graphics.X11.Xlib
-import XMonad
-import StackSet
-
--- $usage
--- > import XMonadContrib.MagicFocus
--- > layouts = [ Layout $ MagicFocus tiled , Layout $ MagicFocus $ Mirror tiled ]
-
--- %import XMonadContrib.MagicFocus
--- %layout , Layout $ MagicFocus tiled
--- %layout , Layout $ MagicFocus $ Mirror tiled
-
-
-data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read )
-
-instance (LayoutClass l Window) => LayoutClass (MagicFocus l) Window where
-          doLayout = magicFocus
-
-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')
-
-swap :: (Eq a) => Stack a -> Maybe a -> Stack a
-swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d)
-                           | otherwise         = Stack f u d

Magnifier.hs

@@ -1,69 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Magnifier
--- Copyright   :  (c) Peter De Wachter 2007
--- License     :  BSD-style (see xmonad/LICENSE)
--- 
--- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Screenshot  :  <http://caladan.rave.org/magnifier.png>
---
--- This layout hack increases the size of the window that has focus.
---
------------------------------------------------------------------------------
-
-
-module XMonadContrib.Magnifier (
-    -- * Usage
-    -- $usage
-    magnifier, magnifier') where
-
-import Graphics.X11.Xlib (Window, Rectangle(..))
-import XMonad
-import StackSet
-import XMonadContrib.LayoutHelpers
-
--- $usage
--- > import XMonadContrib.Magnifier
--- > layouts = [ magnifier tiled , magnifier $ mirror tiled ]
-
--- %import XMonadContrib.Magnifier
--- %layout , magnifier tiled
--- %layout , magnifier $ mirror tiled
-
--- | Increase the size of the window that has focus, unless it is the master window.
-magnifier :: Layout Window -> Layout Window
-magnifier = layoutModify (unlessMaster applyMagnifier) idModMod
-
--- | Increase the size of the window that has focus, even if it is the master window.
-magnifier' :: Layout Window -> Layout Window
-magnifier' = layoutModify applyMagnifier idModMod
-
-unlessMaster :: ModDo Window -> ModDo Window
-unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
-                                              else mainmod r s wrs
-
-applyMagnifier :: ModDo Window
-applyMagnifier r _ wrs = do focused <- withWindowSet (return . peek)
-                            let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify wr)]
-                                              | otherwise         = (w,wr) : ws
-                            return (reverse $ foldr mag [] wrs, Nothing)
-
-magnify :: Rectangle -> Rectangle
-magnify (Rectangle x y w h) = Rectangle x' y' w' h'
-    where x' = x - fromIntegral (w' - w) `div` 2
-          y' = y - fromIntegral (h' - h) `div` 2
-          w' = round $ fromIntegral w * zoom
-          h' = round $ fromIntegral h * zoom
-          zoom = 1.5 :: Double
-
-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')

ManageDocks.hs

@@ -1,102 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.ManageDocks
--- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
--- License      : BSD
---
--- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
--- Stability    : unstable
--- Portability  : unportable
---
--- Makes xmonad detect windows with type DOCK and does not put them in
--- layouts. It also detects window with STRUT set and modifies the
--- gap accordingly.
---
--- Cheveats:
---
---  * Only acts on STRUT apps on creation, not if you move or close them
---
---  * To reset the gap, press Mod-b twice and restart xmonad (Mod-q)
------------------------------------------------------------------------------
-module XMonadContrib.ManageDocks (
-    -- * Usage
-    -- $usage
-    manageDocksHook
-    ) where
-
-import Control.Monad.Reader
-import XMonad
-import Operations
-import qualified StackSet as W
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Data.Word
-
--- $usage
--- Add the imports to your configuration file and add the mangeHook:
---
--- > import XMonadContrib.ManageDocks
---
--- > manageHook w _ _ _  = manageDocksHook w
---
--- and comment out the default `manageHook _ _ _ _ = return id` line.
-
--- %import XMonadContrib.ManageDocks
--- %def -- comment out default manageHook definition above if you uncomment this:
--- %def manageHook w _ _ _ = manageDocksHook w
-
-
--- |
--- Detects if the given window is of type DOCK and if so, reveals it, but does
--- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
-manageDocksHook :: Window -> X (WindowSet -> WindowSet)
-manageDocksHook w = do
-    hasStrut <- getStrut w
-    maybe (return ()) setGap hasStrut
-
-    isDock <- checkDock w
-    if isDock then do
-        reveal w
-        return (W.delete w)
-          else do
-            return id
-
--- |
--- Checks if a window is a DOCK window
-checkDock :: Window -> X (Bool)
-checkDock w = do
-    a <- getAtom "_NET_WM_WINDOW_TYPE"
-    d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
-    mbr <- getProp a w
-    case mbr of
-        Just [r] -> return (fromIntegral r == d)
-        _        -> return False
-
--- |
--- Gets the STRUT config, if present, in xmonad gap order
-getStrut :: Window -> X (Maybe (Int, Int, Int, Int))
-getStrut w = do
-    a <- getAtom "_NET_WM_STRUT"
-    mbr <- getProp a w
-    case mbr of
-        Just [l,r,t,b] -> return (Just (
-                    fromIntegral t,
-                    fromIntegral b,
-                    fromIntegral l,
-                    fromIntegral r))
-        _              -> return Nothing
-
--- |
--- Helper to read a property
-getProp :: Atom -> Window -> X (Maybe [Word32])
-getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
-
--- |
--- Modifies the gap, setting new max
-setGap :: (Int, Int, Int, Int) -> X ()
-setGap gap = modifyGap (\_ -> max4 gap)
-
--- |
--- Piecewise maximum of a 4-tuple of Ints
-max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)
-max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)

MetaModule.hs

@@ -1,89 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.MetaModule
--- Copyright   :  (c) 2007  Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- This is an artificial dependency on all the XMonadContrib.* modules.  It is
--- intended to help xmonad hackers ensure that contrib modules build after API
--- changes.
---
--- Please add new modules to this list (in alphabetical order).
---
------------------------------------------------------------------------------
-
-
-module XMonadContrib.MetaModule () where
-
-import XMonadContrib.Accordion ()
-import XMonadContrib.Anneal ()
-import XMonadContrib.Circle ()
-import XMonadContrib.Commands ()
-import XMonadContrib.Combo () -- broken under ghc head
-import XMonadContrib.CopyWindow ()
-import XMonadContrib.CycleWS ()
-import XMonadContrib.DeManage ()
-import XMonadContrib.DirectoryPrompt ()
-import XMonadContrib.Dishes ()
-import XMonadContrib.Dmenu ()
-import XMonadContrib.DragPane ()
-import XMonadContrib.DwmPromote ()
-import XMonadContrib.DynamicLog ()
-import XMonadContrib.DynamicWorkspaces ()
-import XMonadContrib.Dzen ()
-import XMonadContrib.EwmhDesktops ()
-import XMonadContrib.FindEmptyWorkspace ()
-import XMonadContrib.FlexibleResize ()
-import XMonadContrib.FlexibleManipulate ()
-import XMonadContrib.FloatKeys ()
-import XMonadContrib.FocusNth ()
-import XMonadContrib.Grid ()
-import XMonadContrib.Invisible ()
--- import XMonadContrib.HintedTile ()
-import XMonadContrib.LayoutModifier ()
-import XMonadContrib.LayoutHints ()
-import XMonadContrib.LayoutScreens ()
-import XMonadContrib.MagicFocus ()
-import XMonadContrib.ManageDocks ()
--- import XMonadContrib.Magnifier ()
-import XMonadContrib.Maximize ()
--- import XMonadContrib.Mosaic ()
-import XMonadContrib.MosaicAlt ()
-import XMonadContrib.MouseGestures ()
-import XMonadContrib.NamedWindows ()
-import XMonadContrib.NoBorders ()
-import XMonadContrib.ResizableTile ()
-import XMonadContrib.Roledex ()
-import XMonadContrib.RotSlaves ()
-import XMonadContrib.RotView ()
-import XMonadContrib.RunInXTerm ()
-import XMonadContrib.SetWMName ()
-import XMonadContrib.ShellPrompt ()
-import XMonadContrib.SimpleDate ()
-import XMonadContrib.SinkAll ()
-import XMonadContrib.Spiral ()
-import XMonadContrib.Square ()
-import XMonadContrib.SshPrompt ()
-import XMonadContrib.Submap ()
-import XMonadContrib.SwapWorkspaces ()
-import XMonadContrib.SwitchTrans ()
-import XMonadContrib.Tabbed ()
-import XMonadContrib.TagWindows ()
-import XMonadContrib.ThreeColumns ()
-import XMonadContrib.TwoPane ()
-import XMonadContrib.ViewPrev ()
-import XMonadContrib.XMonadPrompt ()
-import XMonadContrib.XPrompt ()
-import XMonadContrib.XPropManage ()
-import XMonadContrib.XSelection ()
-import XMonadContrib.XUtils ()
-import XMonadContrib.Warp ()
-import XMonadContrib.WindowBringer ()
-import XMonadContrib.WindowNavigation ()
-import XMonadContrib.WindowPrompt ()
-import XMonadContrib.WmiiActions ()
-import XMonadContrib.WorkspaceDir ()

Mosaic.hs

@@ -1,407 +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 XMonadContrib.Mosaic (
-                             -- * Usage
-                             -- $usage
-                             mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,
-                             tallWindow, wideWindow, flexibleWindow,
-                             getName, withNamedWindow ) where
-
-import Control.Monad.State ( State, put, get, runState )
-import System.Random ( StdGen, mkStdGen )
-
-import Data.Ratio
-import Graphics.X11.Xlib
-import XMonad hiding ( trace )
-import Operations ( full, Resize(Shrink, Expand) )
-import qualified StackSet as W
-import qualified Data.Map as M
-import Data.List ( sort )
-import Data.Typeable ( Typeable )
-import Control.Monad ( mplus )
-
-import XMonadContrib.NamedWindows
-import XMonadContrib.Anneal
-
--- $usage
---
--- Key bindings:
--- 
--- You can use this module with the following in your Config.hs:
---
--- > import XMonadContrib.Mosaic
---
--- > layouts :: [Layout Window]
--- > layouts = [ mosaic 0.25 0.5 M.empty, full ]
---
--- In the key-bindings, do something like:
---
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow))
--- >   , ((modMask .|. shiftMask, xK_h     ), withNamedWindow (sendMessage . shrinkWindow))
--- >   , ((modMask .|. shiftMask, xK_l     ), withNamedWindow (sendMessage . expandWindow))
--- >   , ((modMask .|. shiftMask, xK_s     ), withNamedWindow (sendMessage . squareWindow))
--- >   , ((modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . myclearWindow))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . flexibleWindow))
--- 
-
--- %import XMonadContrib.Mosaic
--- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow))
--- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow))
--- %keybind , ((modMask .|. shiftMask, xK_h     ), withNamedWindow (sendMessage . shrinkWindow))
--- %keybind , ((modMask .|. shiftMask, xK_l     ), withNamedWindow (sendMessage . expandWindow))
--- %keybind , ((modMask .|. shiftMask, xK_s     ), withNamedWindow (sendMessage . squareWindow))
--- %keybind , ((modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . myclearWindow))
--- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . flexibleWindow))
--- %layout , mosaic 0.25 0.5 M.empty
-
-data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow
-                  | SquareWindow NamedWindow | ClearWindow NamedWindow
-                  | TallWindow NamedWindow | WideWindow NamedWindow
-                  | FlexibleWindow NamedWindow
-                    deriving ( Typeable, Eq )
-
-instance Message HandleWindow
-
-expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> 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 -> M.Map NamedWindow [WindowHint] -> Layout Window
-mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate
-                                   , modifyLayout = return . mlayout }
-    where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x)
-          m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints
-          m1 Expand = mosaic delta (tileFrac*(1+delta)) hints
-          m2 (ExpandWindow w) = mosaic delta tileFrac (multiply_area (1+delta) w hints)
-          m2 (ShrinkWindow w) = mosaic delta tileFrac (multiply_area (1/(1+ delta)) w hints)
-          m2 (SquareWindow w) = mosaic delta tileFrac (set_aspect_ratio 1 w hints)
-          m2 (FlexibleWindow w) = mosaic delta tileFrac (make_flexible w hints)
-          m2 (TallWindow w) = mosaic delta tileFrac (multiply_aspect (1/(1+delta)) w hints)
-          m2 (WideWindow w) = mosaic delta tileFrac (multiply_aspect (1+delta) w hints)
-          m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w hints)
-
-multiply_area :: Double -> NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [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 -> NamedWindow
-                 -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [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 :: NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
-make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r
-                                        f (FlexibleAspectRatio r) = AspectRatio r
-                                        f x = x
-
-multiply_aspect :: Double -> NamedWindow
-                -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [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
-
-findlist :: Ord k => k -> M.Map k [a] -> [a]
-findlist = M.findWithDefault []
-
-alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [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 NamedWindow [WindowHint]
-        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window))
-mosaicL _ _ _ [] = return ([], Nothing)
-mosaicL f hints origRect origws
-    = do namedws <- mapM getName origws
-         let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws
-             -- 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 (\(nw,r)->(--trace ("rate1:"++ unlines [show nw,
-                                 --                           show $ rate f meanarea (findlist nw hints) r,
-                                 --                           show r,
-                                 --                           show $ area r/meanarea,
-                                 --                           show $ findlist nw hints]) $
-                                 unName nw,crop' (findlist nw 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 -> [[NamedWindow]]
-                     -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle)))
-          even_split r d [ws] = even_split r d $ map (:[]) ws
-          even_split r d wss =
-              do let areas = map sumareas wss
-                 let wsr_s :: [([NamedWindow], Rectangle)]
-                     wsr_s = zip wss (partitionR d r areas)
-                 submosaics <- mapM (\(ws',r') ->
-                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s
-                 return $ fmap M $ catRated submosaics
-          {-
-          another_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
-          another_mosaic ws d = rate_mosaic ratew $
-                                rect_mosaic origRect d $
-                                zipML (example_mosaic ws) (map findarea ws)
-          -}
-          mc_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,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 :: (NamedWindow,Rectangle) -> Double
-          ratew (w,r) = rate f meanarea (findlist w hints) r
-          example_mosaic :: [NamedWindow] -> Mosaic NamedWindow
-          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
-                    rs = partitionR d r areas
-                    d' = otherDirection d
-          rate_mosaic :: ((NamedWindow,Rectangle) -> Double)
-                      -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle))
-          rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m
-{-
-          one_split :: Rectangle -> CutDirection -> [[NamedWindow]]
-                    -> State CountDown (Rated Double (Mosaic (NamedWindow, 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 :: [([NamedWindow], 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 -> [Double] -> [Rectangle]
-          partitionR _ _ [] = []
-          partitionR _ r [_] = [r]
-          partitionR d r (a:ars) = r1 : partitionR d r2 ars
-              where totarea = sum (a:ars)
-                    (r1,r2) = split d (a/totarea) r
-          theareas = hints2area `fmap` hints
-          sumareas ws = sum $ map findarea ws
-          findarea :: NamedWindow -> Double
-          findarea w = M.findWithDefault 1 w theareas
-          meanarea =  area origRect / fromIntegral (length origws)
-
-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
-                | 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
-
-crop :: [WindowHint] -> Rectangle -> Rectangle
-crop (AspectRatio f:_) = cropit f
-crop (FlexibleAspectRatio f:_) = cropit f
-crop (_:hs) = crop hs
-crop [] = id
-
-crop' :: [WindowHint] -> Rectangle -> Rectangle
-crop' (AspectRatio f:_) = cropit f
-crop' (_:hs) = crop' hs
-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 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)

MouseGestures.hs

@@ -1,116 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.MouseGestures
--- Copyright   :  (c) Lukas Mai
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  <l.mai@web.de>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Support for simple mouse gestures
---
------------------------------------------------------------------------------
-
-module XMonadContrib.MouseGestures (
-    -- * Usage
-    -- $usage
-	Direction(..),
-    mouseGesture
-) where
-
-import XMonad
-import Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
-import Control.Monad.Reader
-import Data.IORef
-import qualified Data.Map as M
-import Data.Map (Map)
-
-import System.IO
-
--- $usage
--- In your Config.hs:
---
--- > import XMonadContrib.MouseGestures
--- > ...
--- > mouseBindings = M.fromList $
--- >     [ ...
--- >     , ((modMask .|. shiftMask, button3), mouseGesture gestures)
--- >     ]
--- >     where
--- >     gestures = M.fromList
--- >         [ ([], focus)
--- >         , ([U], \w -> focus w >> windows W.swapUp)
--- >         , ([D], \w -> focus w >> windows W.swapDown)
--- >         , ([R, D], \_ -> sendMessage NextLayout)
--- >         ]
---
--- This is just an example, of course. You can use any mouse button and
--- gesture definitions you want.
-
-data Direction = L | U | R | D
-    deriving (Eq, Ord, Show, Read, Enum, Bounded)
-
-type Pos = (Position, Position)
-
-delta :: Pos -> Pos -> Position
-delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
-    where
-    d a b = abs (a - b)
-
-dir :: Pos -> Pos -> Direction
-dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
-    where
-    trans :: Double -> Direction
-    trans x
-        | rg (-3/4) (-1/4) x = D
-        | rg (-1/4)  (1/4) x = R
-        | rg  (1/4)  (3/4) x = U
-        | 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
-    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'')
-    where
-    insignificant a b = delta a b < 10
-
-extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction]
-extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs
-
-mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()
-mouseGesture tbl win = withDisplay $ \dpy -> do
-    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
-        case M.lookup gest tbl of
-            Nothing -> return ()
-            Just f -> f win'

NoBorders.hs

@@ -1,99 +0,0 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.NoBorders
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Make a given layout display without borders.  This is useful for
--- full-screen or tabbed layouts, where you don't really want to waste a
--- couple of pixels of real estate just to inform yourself that the visible
--- window has focus.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.NoBorders (
-                                -- * Usage
-                                -- $usage
-                                noBorders,
-                                smartBorders,
-                                withBorder
-                               ) where
-
-import Control.Monad.State ( gets )
-import Graphics.X11.Xlib
-
-import XMonad
-import XMonadContrib.LayoutModifier
-import {-# SOURCE #-} Config (borderWidth)
-import qualified StackSet as W
-import Data.List ((\\))
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.NoBorders
---
--- and modify the layouts to call noBorders on the layouts you want to lack
--- borders
---
--- > layouts = [ Layout (noBorders Full), ... ]
-
--- %import XMonadContrib.NoBorders
--- %layout -- prepend noBorders to default layouts above to remove their borders, like so:
--- %layout , noBorders Full
-
--- todo, use an InvisibleList.
-data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show )
-
-instance LayoutModifier WithBorder Window where
-    modifierDescription (WithBorder 0 _) = "NoBorders"
-    modifierDescription (WithBorder n _) = "Borders " ++ show n
-
-    unhook (WithBorder _ s) = setBorders borderWidth s
-
-    redoLayout (WithBorder n s) _ _ wrs = do
-        setBorders borderWidth (s \\ ws)
-        setBorders n ws
-        return (wrs, Just $ WithBorder n ws)
-     where
-        ws = map fst wrs
-
-noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window
-noBorders = ModifiedLayout $ WithBorder 0 []
-
-withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a
-withBorder b = ModifiedLayout $ WithBorder b []
-
-setBorders :: Dimension -> [Window] -> X ()
-setBorders bw ws = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws
-
-data SmartBorder a = SmartBorder [a] deriving (Read, Show)
-
-instance LayoutModifier SmartBorder Window where
-    modifierDescription _ = "SmartBorder"
-
-    unhook (SmartBorder s) = setBorders borderWidth s
-
-    redoLayout (SmartBorder s) _ _ wrs = do
-        ss <- gets (W.screens . windowset)
-
-        if singleton ws && singleton ss
-            then do
-                setBorders borderWidth (s \\ ws)
-                setBorders 0 ws
-                return (wrs, Just $ SmartBorder ws)
-            else do
-                setBorders borderWidth s
-                return (wrs, Just $ SmartBorder [])
-     where
-        ws = map fst wrs
-        singleton = null . drop 1
-
-smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a
-smartBorders = ModifiedLayout (SmartBorder [])

README

@@ -1,20 +1,28 @@
 3rd party xmonad extensions and contributions.
 
-This repository can be overlayed on an xmonad repository.
-Users may then import Haskell src from here, to extend their config
-files.
+Build and install through Cabal as for other Haskell packages:
+
+        runhaskell Setup configure --user --prefix=$HOME
+        runhaskell Setup build
+        runhaskell Setup install --user
+
+(You may want to remove the --user flag when installing as root.)
 
 scripts/ contains further external programs useful with xmonad.
 
 Haskell code contributed to this repo should live under the
+appropriate subdivision of the 'XMonad.' namespace (currently includes
+Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use
+the Mosaic layout, one would import:
 
-    XMonadContrib.
-
-name space. For example:
-
-    XMonadContrib.Mosaic
+ XMonad.Layout.Mosaic
 
 ------------------------------------------------------------------------
 
 Code submitted to the contrib repo is licensed under the same license as
 xmonad itself, with copyright held by the authors.
+
+------------------------------------------------------------------------
+
+Documentation for the extensions and configuration system is available
+in Haddock form in the XMonad.Doc module and submodules.

RotSlaves.hs

@@ -1,49 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.RotSlaves
--- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
--- License      : BSD3-style (see LICENSE)
---
--- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
--- Stability    : unstable
--- Portability  : unportable
---
--- Rotate all windows except the master window 
--- and keep the focus in place.
------------------------------------------------------------------------------
-module XMonadContrib.RotSlaves (
-	-- $usage
-	rotSlaves', rotSlavesUp, rotSlavesDown
-	) where
-
-import StackSet
-import Operations
-import XMonad
-
--- $usage
---
--- To use this module, import it with:
---
--- > import XMonadContrib.RotSlaves
---
--- and add a keybinding:
---
--- > , ((modMask .|. shiftMask, xK_Tab   ), rotSlavesUp) 
---
---
--- This operation will rotate all windows except the master window, while the focus
--- stays where it is. It is useful together with the TwoPane-Layout (see XMonadContrib.TwoPane).
-
--- %import XMonadContrib.RotSlaves
--- %keybind , ((modMask .|. shiftMask, xK_Tab   ), rotSlavesUp)
-
-rotSlavesUp,rotSlavesDown :: X ()
-rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
-rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
-
-rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
-rotSlaves' _ s@(Stack _ [] []) = s
-rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus
-rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise
-    where  (master:ws)     = integrate s
-           (revls',t':rs') = splitAt (length ls) (master:(f ws))

RotView.hs

@@ -1,53 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.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 XMonadContrib.RotView (
-                              -- * Usage
-                              -- $usage
-                              rotView
-                             ) where
-
-import Control.Monad.State ( gets )
-import Data.List ( sortBy, find )
-import Data.Maybe ( isJust )
-import Data.Ord ( comparing )
-
-import XMonad
-import StackSet hiding (filter)
-import Operations
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.RotView
---
--- >   , ((modMask .|. shiftMask, xK_Right), rotView True)
--- >   , ((modMask .|. shiftMask, xK_Left), rotView False)
-
--- %import XMonadContrib.RotView
--- %keybind , ((modMask .|. shiftMask, xK_Right), rotView True)
--- %keybind , ((modMask .|. shiftMask, xK_Left), rotView False)
-
-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)

RunInXTerm.hs

@@ -1,31 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.RunInXTerm
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
--- 
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A simple module to launch commands in an X terminal 
--- from XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.RunInXTerm (
-                             -- * Usage
-                             -- $usage
-                             runInXTerm
-                              ) where
-
-import XMonad
-import System.Environment
-
--- $usage
--- For an example usage see "XMonadContrib.SshPrompt"
-
-runInXTerm :: String -> X ()
-runInXTerm com = do
-  c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm")
-  spawn ("exec " ++ c ++ " -e " ++ com)

Setup.lhs

@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

ShellPrompt.hs

@@ -1,109 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.ShellPrompt
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
---
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A shell prompt for XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.ShellPrompt (
-                             -- * Usage
-                             -- $usage
-                             shellPrompt
-                             , getShellCompl
-                             , split
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-import XMonadContrib.Dmenu
-
-import Control.Monad
-import Data.List
-import Data.Set (toList, fromList)
-import System.Directory
-import System.IO
-import System.Environment
-
--- $usage
---
--- 1. In Config.hs add:
---
--- > import XMonadContrib.XPrompt
--- > import XMonadContrib.ShellPrompt
---
--- 2. In your keybindings add something like:
---
--- >   , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
---
-
--- %import XMonadContrib.XPrompt
--- %import XMonadContrib.ShellPrompt
--- %keybind , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
-
-data Shell = Shell
-
-instance XPrompt Shell where
-    showXPrompt Shell = "Run:   "
-
-shellPrompt :: XPConfig -> X ()
-shellPrompt c = do
-    cmds <- io $ getCommands
-    mkXPrompt Shell c (getShellCompl cmds) spawn
-
-getShellCompl :: [String] -> String -> IO [String]
-getShellCompl cmds s | s == "" || last s == ' ' = return []
-                     | otherwise                = do
-    f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
-    return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s
-
-uniqSort :: Ord a => [a] -> [a]
-uniqSort = toList . fromList
-
-commandCompletionFunction :: [String] -> String -> [String]
-commandCompletionFunction cmds str | '/' `elem` str = []
-                                   | otherwise      = filter (isPrefixOf str) cmds
-
-getCommands :: IO [String]
-getCommands = do
-    p  <- getEnv "PATH" `catch` const (return [])
-    let ds = split ':' p
-        fp d f = d ++ "/" ++ f
-    es <- forM ds $ \d -> do
-        exists <- doesDirectoryExist d
-        if exists
-            then getDirectoryContents d >>= filterM (isExecutable . fp d)
-            else return []
-    return . uniqSort . concat $ es
-
-isExecutable :: FilePath ->IO Bool
-isExecutable f = do
-    fe <- doesFileExist f
-    if fe
-        then fmap executable $ getPermissions f
-        else return False
-
-split :: Eq a => a -> [a] -> [[a]]
-split _ [] = []
-split e l =
-    f : split e (rest ls)
-        where
-          (f,ls) = span (/=e) l
-          rest s | s == []   = []
-                 | otherwise = tail s
-
-escape :: String -> String
-escape []       = ""
-escape (' ':xs) = "\\ " ++ escape xs
-escape (x:xs)
-    | isSpecialChar x = '\\' : x : escape xs
-    | otherwise       = x : escape xs
-
-isSpecialChar :: Char -> Bool
-isSpecialChar =  flip elem "\\@\"'#?$*()[]{};"

SwitchTrans.hs

@@ -1,194 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SwitchTrans
--- Copyright   :  (c) Lukas Mai
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  <l.mai@web.de>
--- Stability   :  unstable
--- Portability :  unportable
---
---
--- Ordinary layout transformers are simple and easy to use but inflexible.
--- This module provides a more structured interface to them.
---
--- The basic idea is to have a base layout and a set of layout transformers,
--- of which at most one is active at any time. Enabling another transformer
--- first disables any currently active transformer; i.e. it works like
--- a group of radio buttons.
---
--- A side effect of this meta-layout is that layout transformers no longer
--- receive any messages; any message not handled by @SwitchTrans@ itself will
--- undo the current layout transformer, pass the message on to the base layout,
--- then reapply the transformer.
---
--- Another potential problem is that functions can't be (de-)serialized so this
--- layout will not preserve state across xmonad restarts.
---
--- Here's how you might use this in Config.hs:
---
--- > layouts =
--- >     map (
--- >         mkSwitch (M.fromList [
--- >             ("full", const $ Layout $ noBorders Full)
--- >         ]) .
--- >         mkSwitch (M.fromList [
--- >             ("mirror", Layout . Mirror)
--- >         ])
--- >     ) [ Layout tiled ]
---
--- (The @noBorders@ transformer is from "XMonadContrib.NoBorders".)
---
--- This example is probably overkill but it's very close to what I actually use.
--- Anyway, this layout behaves like the default @tiled@ layout, until you send it
--- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@:
---
--- > ...
--- >    , ((modMask,               xK_f     ), sendMessage $ Toggle "full")
--- >    , ((modMask,               xK_r     ), sendMessage $ Toggle "mirror")
---
--- (You may want to use other keys. I don't use Xinerama so the default mod-r
--- binding is useless to me.)
---
--- After this, pressing @mod-f@ switches the current window to fullscreen mode.
--- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout
--- by 90 degrees (and back). The nice thing is that your changes are kept:
--- Rotating first then changing the size of the master area then rotating back
--- does not undo the master area changes.
---
--- The reason I use two stacked @SwitchTrans@ transformers instead of @mkSwitch
--- (M.fromList [(\"full\", const $ Layout $ noBorders Full), (\"mirror\",
--- Layout . Mirror)])@ is that I use @mod-f@ to \"zoom in\" on interesting
--- windows, no matter what other layout transformers may be active. Having an
--- extra fullscreen mode on top of everything else means I can zoom in and out
--- without implicitly undoing \"normal\" layout transformers, like @Mirror@.
--- Remember, inside a @SwitchTrans@ there can be at most one active layout
--- transformer.
------------------------------------------------------------------------------
-
-module XMonadContrib.SwitchTrans (
-    Toggle(..),
-    Enable(..),
-    Disable(..),
-    mkSwitch
-) where
-
-import XMonad
-import Operations
-
-import qualified Data.Map as M
-import Data.Map (Map)
-
---import System.IO
-
-
--- | Toggle the specified layout transformer.
-data Toggle = Toggle String deriving (Eq, Typeable)
-instance Message Toggle
--- | Enable the specified transformer.
-data Enable = Enable String deriving (Eq, Typeable)
-instance Message Enable
--- | Disable the specified transformer.
-data Disable = Disable String deriving (Eq, Typeable)
-instance Message Disable
-
-data SwitchTrans a = SwitchTrans {
-    base :: Layout a,
-    currTag :: Maybe String,
-    currLayout :: Layout a,
-    currFilt :: Layout a -> Layout a,
-    filters :: Map String (Layout a -> Layout a)
-}
-
-instance Show (SwitchTrans a) where
-    show st = "SwitchTrans #<base: " ++ show (base st) ++ ", tag: " ++ show (currTag st) ++ ", layout: " ++ show (currLayout st) ++ ", ...>"
-
-instance Read (SwitchTrans a) where
-    readsPrec _ _ = []
-
-unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r
-unLayout (Layout l) k = k l
-
-acceptChange :: (LayoutClass l a) => SwitchTrans a -> ((l a -> SwitchTrans a) -> b -> c) -> X b -> X c
-acceptChange st f action =
-    -- seriously, Dave, you need to stop this
-    fmap (f (\l -> st{ currLayout = Layout l})) action
-
-instance LayoutClass SwitchTrans a where
-    description _ = "SwitchTrans"
-
-    doLayout st r s = currLayout st `unLayout` \l -> do
-        --io $ hPutStrLn stderr $ "[ST]{ " ++ show st
-        x{- @(_, w) -} <- acceptChange st (fmap . fmap) (doLayout l r s)
-        --io $ hPutStrLn stderr $ "[ST]} " ++ show w
-        return x
-
-    pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s
-
-    handleMessage st m
-        | Just (Disable tag) <- fromMessage m
-        , M.member tag (filters st)
-            = provided (currTag st == Just tag) $ disable
-        | Just (Enable tag) <- fromMessage m
-        , Just alt <- M.lookup tag (filters st)
-            = provided (currTag st /= Just tag) $ enable tag alt
-        | Just (Toggle tag) <- fromMessage m
-        , Just alt <- M.lookup tag (filters st)
-            =
-            if (currTag st == Just tag) then
-                disable
-            else
-                enable tag alt
-        | Just ReleaseResources <- fromMessage m
-            = currLayout st `unLayout` \cl -> do
-                --io $ hPutStrLn stderr $ "[ST]~ " ++ show st
-                acceptChange st fmap (handleMessage cl m)
-        | Just Hide <- fromMessage m
-            = currLayout st `unLayout` \cl -> do
-                --io $ hPutStrLn stderr $ "[ST]< " ++ show st
-                x <- acceptChange st fmap (handleMessage cl m)
-                --io $ hPutStrLn stderr $ "[ST]> " ++ show x
-                return x
-        | otherwise = base st `unLayout` \b -> do
-            x <- handleMessage b m
-            case x of
-                Nothing -> return Nothing
-                Just b' -> currLayout st `unLayout` \cl -> do
-                    handleMessage cl (SomeMessage ReleaseResources)
-                    let b'' = Layout b'
-                    return . Just $ st{ base = b'', currLayout = currFilt st b'' }
-        where
-        enable tag alt = currLayout st `unLayout` \cl -> do
-            --io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st))
-            handleMessage cl (SomeMessage ReleaseResources)
-            return . Just $ st{
-                currTag = Just tag,
-                currFilt = alt,
-                currLayout = alt (base st) }
-        disable = currLayout st `unLayout` \cl -> do
-            --io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st)
-            handleMessage cl (SomeMessage ReleaseResources)
-            return . Just $ st{
-                currTag = Nothing,
-                currFilt = id,
-                currLayout = base st }
-
--- | Take a transformer table and a base layout, and return a
--- SwitchTrans layout.
-mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a
-mkSwitch fs b = Layout st
-    where
-    st = SwitchTrans{
-        base = b,
-        currTag = Nothing,
-        currLayout = b,
-        currFilt = id,
-        filters = fs }
-        
-provided :: Bool -> X (Maybe a) -> X (Maybe a)
-provided c x
-    | c = x
-    | otherwise = return Nothing
-

Tabbed.hs

@@ -1,214 +0,0 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Tabbed
--- Copyright   :  (c) 2007 David Roundy, Andrea Rossato
--- License     :  BSD-style (see xmonad/LICENSE)
--- 
--- Maintainer  :  droundy@darcs.net, andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A tabbed layout for the Xmonad Window Manager 
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Tabbed ( 
-                             -- * Usage:
-                             -- $usage
-                             tabbed
-                            , shrinkText
-                            , TConf (..), defaultTConf
-                            ) where
-
-import Control.Monad.State ( gets )
-import Control.Monad.Reader
-import Data.Maybe
-import Data.Bits
-import Data.List
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
-import XMonad
-import Operations
-import qualified StackSet as W
-
-import XMonadContrib.NamedWindows
-import XMonadContrib.Invisible
-import XMonadContrib.XUtils
-
--- $usage
--- You can use this module with the following in your configuration file:
---
--- > import XMonadContrib.Tabbed
---
--- > layouts :: [Layout Window]
--- > layouts = [ Layout tiled
--- >           , Layout $ Mirror tiled
--- >           , Layout Full
--- >
--- >           -- Extension-provided layouts
--- >           , Layout $ tabbed shrinkText defaultTConf
--- >           ]
--- >                  
--- >                  , ... ]
---
--- You can also edit the default configuration options.
---
--- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000"
--- >                            , activeTextColor = "#00FF00"}
---
--- and
---
--- > layouts = [ ...
--- >           , Layout $ tabbed shrinkText myTabConfig ]
-
--- %import XMonadContrib.Tabbed
--- %layout , tabbed shrinkText defaultTConf
-
-tabbed :: Shrinker -> TConf -> Tabbed a
-tabbed s t = Tabbed (I Nothing) (I (Just s)) t
-
-data TConf = 
-    TConf { activeColor         :: String
-          , inactiveColor       :: String
-          , activeBorderColor   :: String
-          , inactiveTextColor   :: String
-          , inactiveBorderColor :: String
-          , activeTextColor     :: String
-          , fontName            :: String
-          , tabSize             :: Int
-          } deriving (Show, Read)
-
-defaultTConf :: TConf
-defaultTConf = 
-    TConf { activeColor         = "#999999"
-          , inactiveColor       = "#666666"
-          , activeBorderColor   = "#FFFFFF"
-          , inactiveBorderColor = "#BBBBBB"
-          , activeTextColor     = "#FFFFFF"
-          , inactiveTextColor   = "#BFBFBF"
-          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-          , tabSize             = 20
-          }
-
-data TabState = 
-    TabState { tabsWindows :: [(Window,Window)]
-             , scr         :: Rectangle
-             , fontS       :: FontStruct -- FontSet
-    }
-
-data Tabbed a = 
-    Tabbed (Invisible Maybe TabState) (Invisible Maybe Shrinker) TConf
-    deriving (Show, Read)
-
-instance LayoutClass Tabbed Window where
-    doLayout (Tabbed ist ishr conf) = doLay ist ishr conf
-    handleMessage                   = handleMess
-    description _                   = "Tabbed"
-
-doLay :: Invisible Maybe TabState -> Invisible Maybe Shrinker -> TConf 
-      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed 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 conf 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 conf 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 conf sc ws
-                                   return (ts {scr = sc, tabsWindows = zip tws ws})
-  mapM_ showWindow $ map fst $ tabsWindows st
-  mapM_ (updateTab ishr conf (fontS st) width) $ tabsWindows st
-  return ([(w,shrink conf sc)], Just (Tabbed (I (Just st)) ishr conf))
-
-handleMess :: Tabbed Window -> SomeMessage -> X (Maybe (Tabbed 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
-                                                  releaseFont (fontS st)
-                                                  return $ Just $ Tabbed (I Nothing) (I Nothing) conf
-handleMess _ _  = return Nothing
-
-handleEvent :: Invisible Maybe Shrinker -> TConf -> TabState -> Event -> X ()
--- button press
-handleEvent ishr conf (TabState    {tabsWindows = tws,   scr          = screen, fontS         = 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)
--- propertyNotify
-handleEvent ishr conf (TabState      {tabsWindows = tws, scr = screen, fontS = 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, fontS = 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  <- initFont (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)
-  io $ restackWindows d $ w : [ow]
-  ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows
-  return (w:ws)
-
-updateTab :: Invisible Maybe Shrinker -> TConf -> FontStruct -> Dimension -> (Window,Window) -> X ()
-updateTab ishr c fs wh (tabw,ow) = do
-  nw <- getName ow
-  let ht                   = fromIntegral $ tabSize c :: Dimension
-      focusColor win ic ac = (maybe ic (\focusw -> if focusw == win 
-                                                   then ac else ic) . W.peek) 
-                             `fmap` gets windowset
-  (bc',borderc',tc') <- focusColor ow
-                           (inactiveColor c, inactiveBorderColor c, inactiveTextColor c) 
-                           (activeColor   c, activeBorderColor   c, activeTextColor   c)
-  let s    = fromIMaybe shrinkText ishr 
-      name = shrinkWhile s (\n -> textWidth fs n >
-                            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))
-
-type Shrinker = String -> [String]
-
-shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String
-shrinkWhile sh p x = sw $ sh x
-    where sw [n] = n
-          sw [] = ""
-          sw (n:ns) | p n = sw ns
-                    | otherwise = n
-
-shrinkText :: Shrinker
-shrinkText "" = [""]
-shrinkText cs = cs : shrinkText (init cs)

ViewPrev.hs

@@ -1,26 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.ViewPrev
--- Copyright   :  (c) Nelson Elhage <nelhage@mit.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Nelson Elhage <nelhage@mit.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module that implements a command to switch to the previously
--- viewed workspace
---
------------------------------------------------------------------------------
-
-module XMonadContrib.ViewPrev (
-                               viewPrev
-                              ) where
-
-import XMonad
-import Operations 
-import qualified StackSet as W
-
-viewPrev :: X ()
-viewPrev = windows viewPrev'
-    where viewPrev' x = W.view (W.tag . head . W.hidden $ x) x

WindowNavigation.hs

@@ -1,177 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.WorkspaceDir
--- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- WindowNavigation is an extension to allow easy navigation of a workspace.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.WindowNavigation ( 
-                                   -- * Usage
-                                   -- $usage
-                                   windowNavigation,
-                                   Navigate(..), Direction(..),
-                                   WNConfig (..), defaultWNConfig
-                                  ) where
-
-import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder )
-import Control.Monad ( when )
-import Control.Monad.Reader ( ask )
-import Data.List ( nub, sortBy, (\\) )
-import XMonad
-import qualified StackSet as W
-import Operations ( windows, focus, LayoutMessages(..) )
-import XMonadContrib.LayoutModifier
-import XMonadContrib.Invisible
-import XMonadContrib.XUtils
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.WindowNavigation
--- >
--- > layoutHook = Layout $ windowNavigation defaultWNConfig $ Select ...
---
--- In keybindings:
---
--- >    , ((modMask, xK_Right), sendMessage $ Go R)
--- >    , ((modMask, xK_Left), sendMessage $ Go L)
--- >    , ((modMask, xK_Up), sendMessage $ Go U)
--- >    , ((modMask, xK_Down), sendMessage $ Go D)
-
--- %import XMonadContrib.WindowNavigation
--- %keybind , ((modMask, xK_Right), sendMessage $ Go R)
--- %keybind , ((modMask, xK_Left), sendMessage $ Go L)
--- %keybind , ((modMask, xK_Up), sendMessage $ Go U)
--- %keybind , ((modMask, xK_Down), sendMessage $ Go D)
--- %keybind , ((modMask .|. controlMask, xK_Right), sendMessage $ Swap R)
--- %keybind , ((modMask .|. controlMask, xK_Left), sendMessage $ Swap L)
--- %keybind , ((modMask .|. controlMask, xK_Up), sendMessage $ Swap U)
--- %keybind , ((modMask .|. controlMask, xK_Down), sendMessage $ Swap D)
--- %layout -- include 'windowNavigation' in layoutHook definition above.
--- %layout -- just before the list, like the following (don't uncomment next line):
--- %layout -- layoutHook = Layout $ windowNavigation defaultWNConfig $ ...
-
-
-data Navigate = Go Direction | Swap Direction deriving ( Read, Show, Typeable )
-data Direction = U | D | R | L deriving ( Read, Show, Eq )
-instance Message Navigate
-
-data WNConfig = 
-    WNC { showNavigable :: Bool
-        , upColor       :: String
-        , downColor     :: String
-        , leftColor     :: String
-        , rightColor    :: String
-        } deriving (Show, Read)
-
-defaultWNConfig :: WNConfig
-defaultWNConfig = WNC True "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"
-
-data NavigationState a = NS Point [(a,Rectangle)]
-
-data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show )
-
-windowNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a
-windowNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
-
-instance LayoutModifier WindowNavigation Window where
-    redoLayout (WindowNavigation conf (I state)) rscr s wrs =
-        do XConf { normalBorder = nbc } <- ask
-           [uc,dc,lc,rc] <- mapM stringToPixel [upColor conf, downColor conf, leftColor conf, rightColor conf]
-           let dirc U = uc
-               dirc D = dc
-               dirc L = lc
-               dirc R = rc
-           let w    = W.focus s
-               r    = case filter ((==w).fst) wrs of ((_,x):_) -> x
-                                                     []        -> rscr
-               pt   = case state of Just (NS ptold _) | ptold `inrect` r -> ptold
-                                    _ -> center r
-               wrs' = filter ((/=w) . fst) wrs
-               wnavigable = nub $ concatMap
-                            (\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]
-               wothers = case state of Just (NS _ wo) -> map fst wo
-                                       _              -> []
-           mapM_ (sc nbc) (wothers \\ map fst wnavigable)
-           when (showNavigable conf) $ mapM_ (\(win,c) -> sc c win) wnavigablec
-           return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
-
-    handleMess (WindowNavigation conf (I (Just (NS pt wrs)))) m
-        | Just (Go d) <- fromMessage m =
-                         case sortby d $ filter (inr d pt . snd) wrs of
-                         []        -> return Nothing
-                         ((w,r):_) -> do focus w
-                                         return $ Just $ WindowNavigation conf $ I $ Just $
-                                                NS (centerd d pt r) wrs
-        | Just (Swap d) <- fromMessage m =
-             case sortby d $ filter (inr d pt . snd) wrs of
-             []        -> return Nothing
-             ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st
-                                 swapw y x | x == w = y
-                                           | x == y = w
-                                           | otherwise = x
-                                 unint f xs = case span (/= f) xs of
-                                              (u,_:dn) -> W.Stack { W.focus = f
-                                                                  , W.up = reverse u
-                                                                  , W.down = dn }
-                                              _ -> W.Stack { W.focus = f
-                                                           , W.down = xs
-                                                           , W.up = [] }
-                             windows $ W.modify' swap
-                             return Nothing
-        | Just Hide <- fromMessage m =
-                       do XConf { normalBorder = nbc } <- ask
-                          mapM_ (sc nbc . fst) wrs
-                          return $ Just $ WindowNavigation conf $ I $ Just $ NS pt []
-        | Just ReleaseResources <- fromMessage m =
-               handleMess (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
-    handleMess _ _ = return Nothing
-
-truncHead :: [a] -> [a]
-truncHead (x:_) = [x]
-truncHead [] = []
-
-sc :: Pixel -> Window -> X ()
-sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c
-
-center :: Rectangle -> Point
-center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2)  (fromIntegral y + fromIntegral h/2)
-
-centerd :: Direction -> Point -> Rectangle -> Point
-centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2)
-                                        | otherwise = P (fromIntegral x + fromIntegral w/2) yy
-
-inr :: Direction -> Point -> Rectangle -> Bool
-inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
-                                     y <  fromIntegral yr + fromIntegral h
-inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
-                                     y >  fromIntegral yr
-inr R (P a x) (Rectangle b l _ w)  = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
-                                     a <  fromIntegral b
-inr L (P a x) (Rectangle b l c w)  = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&
-                                     a >  fromIntegral b + fromIntegral c
-
-inrect :: Point -> Rectangle -> Bool
-inrect (P x y) (Rectangle a b w h) = x >  fromIntegral a && x < fromIntegral a + fromIntegral w &&
-                                     y >  fromIntegral b && y < fromIntegral b + fromIntegral h
-
-sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)]
-sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y)
-sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y')
-sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x')
-sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x)
-
-data Point = P Double Double

WmiiActions.hs

@@ -1,101 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.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 known from Wmii window manager (
--- <http://wmii.suckless.org>). It also provides slightly better interface for
--- running dmenu on xinerama screens. If you want to use xinerama functions,
--- you have to apply following patch (see Dmenu.hs extension):
--- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>.  Don't forget to
--- recompile dmenu afterwards ;-).
------------------------------------------------------------------------------
-
-module XMonadContrib.WmiiActions (
-                                 -- * Usage
-                                 -- $usage
-                                   wmiiActions
-                                 , wmiiActionsXinerama
-                                 , executables
-                                 , executablesXinerama
-                                 ) where
-
-import XMonad
-import XMonadContrib.Dmenu (dmenu, dmenuXinerama, 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 Config.hs file:
---
--- > import XMonadContrib.WmiiActions
---
---  and add following to the list of keyboard bindings:
---
--- > ,((modMask, xK_a), wmiiActions "/home/joe/.wmii-3.5/")
---
--- or, if you are using xinerama, you can use
---
--- > ,((modMask, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/")
---
--- however, make sure you have also xinerama build of dmenu (for more
--- information see "XMonadContrib.Dmenu" extension).
-
--- | The 'wmiiActions' function takes the file path as a first argument and
--- executes dmenu with all 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 workspace which currently owns focus.
-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 dmenu_path script providing list of
--- executable files accessible from $PATH variable.
-executables :: X ()
-executables = executablesDmenu dmenu
-
--- | The 'executablesXinerama' function does the same as 'executables' function
--- but on workspace which currently owns 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" [] ""
-

WorkspaceDir.hs

@@ -1,78 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.WorkspaceDir
--- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- WorkspaceDir is an extension to set the current directory in a workspace.
---
--- Actually, it sets the current directory in a layout, since there's no way I
--- know of to attach a behavior to a workspace.  This means that any terminals
--- (or other programs) pulled up in that workspace (with that layout) will
--- execute in that working directory.  Sort of handy, I think.
--- 
--- Requires the 'directory' package
---
------------------------------------------------------------------------------
-
-module XMonadContrib.WorkspaceDir ( 
-                                   -- * Usage
-                                   -- $usage
-                                   workspaceDir, 
-                                   changeDir
-                                  ) where
-
-import System.Directory ( setCurrentDirectory )
-
-import XMonad
-import Operations ( sendMessage )
-import XMonadContrib.Dmenu ( runProcessWithInput )
-import XMonadContrib.XPrompt ( XPConfig )
-import XMonadContrib.DirectoryPrompt ( directoryPrompt )
-import XMonadContrib.LayoutModifier
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.WorkspaceDir
--- >
--- > layouts = map (workspaceDir "~") [ tiled, ... ]
---
--- In keybindings:
---
--- >  , ((modMask .|. shiftMask, xK_x     ), changeDir defaultXPConfig)
-
--- %import XMonadContrib.WorkspaceDir
--- %keybind , ((modMask .|. shiftMask, xK_x     ), changeDir defaultXPConfig)
--- %layout -- prepend 'map (workspaceDir "~")' to layouts definition above,
--- %layout -- just before the list, like the following (don't uncomment next line):
--- %layout -- layouts = map (workspaceDir "~") [ tiled, ... ]
-
-
-data Chdir = Chdir String deriving ( Typeable )
-instance Message Chdir
-
-data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show )
-
-instance LayoutModifier WorkspaceDir a where
-    hook (WorkspaceDir s) = scd s
-    handleMess (WorkspaceDir _) m = return $ do Chdir wd <- fromMessage m
-                                                Just (WorkspaceDir wd)
-
-workspaceDir :: LayoutClass l a => String -> l a
-             -> ModifiedLayout WorkspaceDir l a
-workspaceDir s = ModifiedLayout (WorkspaceDir s)
-
-scd :: String -> X ()
-scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x)
-           catchIO $ setCurrentDirectory x'
-
-changeDir :: XPConfig -> X ()
-changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)

XMonad/Actions/Commands.hs

@@ -0,0 +1,120 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Commands
+-- Copyright   :  (c) David Glasser 2007
+-- License     :  BSD3
+--
+-- Maintainer  :  glasser@mit.edu
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Allows you to run internal xmonad commands (X () actions) using
+-- a dmenu menu in addition to key bindings.  Requires dmenu and
+-- the Dmenu XMonad.Actions module.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Commands (
+                             -- * Usage
+                             -- $usage
+                             commandMap,
+                             runCommand,
+                             runCommand',
+                             workspaceCommands,
+                             screenCommands,
+                             defaultCommands
+                              ) where
+
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+import XMonad.Util.Dmenu (dmenu)
+
+import qualified Data.Map as M
+import System.Exit
+import Data.Maybe
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.Commands
+--
+-- Then add a keybinding to the runCommand action:
+--
+-- >    , ((modMask x .|. controlMask, xK_y), commands >>= runCommand)
+--
+-- and define the list of commands you want to use:
+--
+-- >    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 returned by 'commands'.  (If you like it
+-- enough, you may even want to get rid of many of your other key
+-- bindings!)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
+--   list of pairs.
+commandMap :: [(String, X ())] -> M.Map String (X ())
+commandMap c = M.fromList c
+
+-- | Generate a list of commands to switch to\/send windows to workspaces.
+workspaceCommands :: X [(String, X ())]
+workspaceCommands = asks (workspaces . config) >>= \spaces -> return
+                            [((m ++ show i), windows $ f i)
+                                | i <- spaces
+                                , (f, m) <- [(view, "view"), (shift, "shift")] ]
+
+-- | Generate a list of commands dealing with multiple screens.
+screenCommands :: [(String, X ())]
+screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
+                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
+                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]
+                 ]
+
+-- | A nice pre-defined list of commands.
+defaultCommands :: X [(String, X ())]
+defaultCommands = do
+    wscmds <- workspaceCommands
+    return $ wscmds ++ screenCommands ++ otherCommands
+ where
+    sr = broadcastMessage ReleaseResources
+    otherCommands =
+        [ ("shrink"              , sendMessage Shrink                               )
+        , ("expand"              , sendMessage Expand                               )
+        , ("next-layout"         , sendMessage NextLayout                           )
+        , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )
+        , ("restart-wm"          , sr >> restart "xmonad" True                       )
+        , ("restart-wm-no-resume", sr >> restart "xmonad" False                      )
+        , ("xterm"               , spawn =<< asks (terminal .  config)              )
+        , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )
+        , ("kill"                , kill                                             )
+        , ("refresh"             , refresh                                          )
+        , ("focus-up"            , windows $ focusUp                                )
+        , ("focus-down"          , windows $ focusDown                              )
+        , ("swap-up"             , windows $ swapUp                                 )
+        , ("swap-down"           , windows $ swapDown                               )
+        , ("swap-master"         , windows $ swapMaster                             )
+        , ("sink"                , withFocused $ windows . sink                     )
+        , ("quit-wm"             , io $ exitWith ExitSuccess                        )
+        ]
+
+-- | Given a list of command\/action pairs, prompt the user to choose a
+--   command and return the corresponding action.
+runCommand :: [(String, X ())] -> X ()
+runCommand cl = do
+  let m = commandMap cl
+  choice <- dmenu (M.keys m)
+  fromMaybe (return ()) (M.lookup choice m)
+
+-- | Given the name of a command from 'defaultCommands', return the
+--   corresponding action (or the null action if the command is not
+--   found).
+runCommand' :: String -> X ()
+runCommand' c = do
+  m <- fmap commandMap defaultCommands
+  fromMaybe (return ()) (M.lookup c m)

XMonad/Actions/ConstrainedResize.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.ConstrainedResize
+-- Copyright   :  (c) Dougal Stanton
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <dougal@dougalstanton.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Lets you constrain the aspect ratio of a floating
+-- window (by, say, holding shift while you resize).
+--
+-- Useful for making a nice circular XClock window.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.ConstrainedResize (
+        -- * Usage
+        -- $usage
+        XMonad.Actions.ConstrainedResize.mouseResizeWindow
+) where
+
+import XMonad
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import qualified XMonad.Actions.ConstrainedResize as Sqr
+--
+-- Then add something like the following to your mouse bindings:
+--
+-- >     , ((modMask x, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))
+-- >     , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))
+--
+-- The line without the shiftMask replaces the standard mouse resize
+-- function call, so it's not completely necessary but seems neater
+-- this way.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+-- | Resize (floating) window with optional aspect ratio constraints.
+mouseResizeWindow :: Window -> Bool -> X ()
+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    mouseDrag (\ex ey -> do
+                 let x = ex - fromIntegral (wa_x wa)
+                     y = ey - fromIntegral (wa_y wa)
+                     sz = if c then (max x y, max x y) else (x,y)
+                 io $ resizeWindow d w `uncurry`
+                    applySizeHints sh sz)
+              (float w)

XMonad/Actions/CopyWindow.hs

@@ -0,0 +1,85 @@
+{-# LANGUAGE PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CopyWindow
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides a binding to duplicate a window on multiple workspaces,
+-- providing dwm-like tagging functionality.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CopyWindow (
+                                 -- * Usage
+                                 -- $usage
+                                 copy, copyWindow, kill1
+                                ) where
+
+import Prelude hiding ( filter )
+import qualified Data.List as L
+import XMonad hiding (modify)
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CopyWindow
+--
+-- Then add something like this to your keybindings:
+--
+-- > -- mod-[1..9] @@ Switch to workspace N
+-- > -- mod-shift-[1..9] @@ Move client to workspace N
+-- > -- mod-control-shift-[1..9] @@ Copy client to workspace N
+-- > [((m .|. modMask x, k), windows $ f i)
+-- >     | (i, k) <- zip (workspaces x) [xK_1 ..]
+-- >     , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]]
+--
+-- To use the above key bindings you need also to import
+-- "XMonad.StackSet":
+--
+-- > import qualified XMonad.StackSet as W
+--
+-- You may also wish to redefine the binding to kill a window so it only
+-- removes it from the current workspace, if it's present elsewhere:
+--
+-- >  , ((modMask x .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | copy. Copy the focussed window to a new workspace.
+copy :: WorkspaceId -> WindowSet -> WindowSet
+copy n s | Just w <- peek s = copyWindow w n s
+         | otherwise = s
+
+-- | copyWindow.  Copy a window to a new workspace
+copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet
+copyWindow w n = copy'
+    where copy' s = if n `tagMember` s
+                    then view (tag (workspace (current s))) $ insertUp' w $ view n s
+                    else s
+          insertUp' a s = modify (Just $ Stack a [] [])
+                          (\(Stack t l r) -> if a `elem` t:l++r
+                                             then Just $ Stack t l r
+                                             else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s
+
+
+-- | Remove the focused window from this workspace.  If it's present in no
+-- other workspace, then kill it instead. If we do kill it, we'll get a
+-- delete notify back from X.
+--
+-- There are two ways to delete a window. Either just kill it, or if it
+-- supports the delete protocol, send a delete event (e.g. firefox)
+--
+kill1 :: X ()
+kill1 = do ss <- gets windowset
+           whenJust (peek ss) $ \w -> if member w $ delete'' w ss
+                                      then windows $ delete'' w
+                                      else kill
+    where delete'' w = modify Nothing (filter (/= w))

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

@@ -0,0 +1,290 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleWS
+-- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>,
+--                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- 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
+
+                                -- * 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 ( isNothing, isJust )
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet hiding (filter)
+import XMonad.Util.WorkspaceCompare
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleWS
+-- >
+-- > -- a basic CycleWS setup
+-- >
+-- >   , ((modMask x,               xK_Down),  nextWS)
+-- >   , ((modMask x,               xK_Up),    prevWS)
+-- >   , ((modMask x .|. shiftMask, xK_Down),  shiftToNext)
+-- >   , ((modMask x .|. shiftMask, xK_Up),    shiftToPrev)
+-- >   , ((modMask x,               xK_Right), nextScreen)
+-- >   , ((modMask x,               xK_Left),  prevScreen)
+-- >   , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen)
+-- >   , ((modMask x .|. shiftMask, xK_Left),  shiftPrevScreen)
+-- >   , ((modMask x,               xK_z),     toggleWS)
+--
+-- If you want to follow the moved window, you can use both actions:
+--
+-- >   , ((modMask x .|. shiftMask, xK_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
+
+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 the previous workspace.
+prevWS :: X ()
+prevWS = switchWorkspace (-1)
+
+-- | Move the focused window to the next workspace.
+shiftToNext :: X ()
+shiftToNext = shiftBy 1
+
+-- | Move the focused window to the previous workspace.
+shiftToPrev :: X ()
+shiftToPrev = shiftBy (-1)
+
+-- | Toggle to the workspace displayed previously.
+toggleWS :: X ()
+toggleWS = windows $ view =<< tag . head . hidden
+
+switchWorkspace :: Int -> X ()
+switchWorkspace d = wsBy d >>= windows . greedyView
+
+shiftBy :: Int -> X ()
+shiftBy d = wsBy d >>= windows . shift
+
+wsBy :: Int -> X (WorkspaceId)
+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
+findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
+
+-- | View next screen
+nextScreen :: X ()
+nextScreen = switchScreen 1
+
+-- | View prev screen
+prevScreen :: X ()
+prevScreen = switchScreen (-1)
+
+switchScreen :: Int -> X ()
+switchScreen d = do s <- screenBy d
+                    mws <- screenWorkspace s
+                    case mws of
+                         Nothing -> return ()
+                         Just ws -> windows (view ws)
+
+screenBy :: Int -> X (ScreenId)
+screenBy d = do ws <- gets windowset
+                --let ss = sortBy screen (screens ws)
+                let now = screen (current ws)
+                return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws))
+
+-- | Swap current screen with next screen
+swapNextScreen :: X ()
+swapNextScreen = swapScreen 1
+
+-- | Swap current screen with previous screen
+swapPrevScreen :: X ()
+swapPrevScreen = swapScreen (-1)
+
+swapScreen :: Int -> X ()
+swapScreen d = do s <- screenBy d
+                  mws <- screenWorkspace s
+                  case mws of
+                    Nothing -> return ()
+                    Just ws -> windows (greedyView ws)
+
+-- | Move focused window to workspace on next screen
+shiftNextScreen :: X ()
+shiftNextScreen = shiftScreenBy 1
+
+-- | Move focused window to workspace on prev screen
+shiftPrevScreen :: X ()
+shiftPrevScreen = shiftScreenBy (-1)
+
+shiftScreenBy :: Int -> X ()
+shiftScreenBy d = do s <- screenBy d
+                     mws <- screenWorkspace s
+                     case mws of
+                         Nothing -> return ()
+                         Just ws -> windows (shift ws)

XMonad/Actions/DeManage.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.DeManage
+-- Module      :  XMonad.Actions.DeManage
 -- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -8,49 +8,47 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- This module provides a method to cease management of a window, without
--- unmapping it.  This is especially useful for applications like kicker and
--- gnome-panel.
+-- This module provides a method to cease management of a window
+-- without unmapping it.  This is especially useful for applications
+-- like kicker and gnome-panel.
 --
 -- To make a panel display correctly with xmonad:
 --
---  * Determine the pixel size of the panel, add that value to defaultGaps
+--  * Determine the pixel size of the panel, add that value to
+--    'XMonad.Core.XConfig.defaultGaps'
 --
 --  * Launch the panel
 --
---  * Give the panel window focus, then press mod-d
+--  * Give the panel window focus, then press @mod-d@ (or whatever key
+--    you have bound 'demanage' to)
 --
 --  * Convince the panel to move\/resize to the correct location.  Changing the
 --  panel's position setting several times seems to work.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.DeManage (
+module XMonad.Actions.DeManage (
                                  -- * Usage
                                  -- $usage
                                  demanage
                                 ) where
 
-import qualified StackSet as W
+import qualified XMonad.StackSet as W
 import XMonad
-import Operations
-import Control.Monad.State
-import Graphics.X11 (Window)
 
 -- $usage
--- To use demanage, add this import:
+-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:
 --
--- >     import XMonadContrib.DeManage
+-- >     import XMonad.Actions.DeManage
 --
--- And add a keybinding to it:
+-- And add a keybinding, such as:
 --
--- > , ((modMask,               xK_d     ), withFocused demanage)
+-- > , ((modMask x,               xK_d     ), withFocused demanage)
 --
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
--- %import XMonadContrib.DeManage
--- %keybind , ((modMask,               xK_d     ), withFocused demanage)
-
--- | Stop managing the current focused window.
+-- | Stop managing the currently focused window.
 demanage :: Window -> X ()
 demanage w = do
     -- use modify to defeat automatic 'unmanage' calls.

XMonad/Actions/DwmPromote.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.DwmPromote
+-- Module      :  XMonad.Actions.DwmPromote
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -9,36 +9,38 @@
 -- Portability :  unportable
 --
 -- Dwm-like swap function for xmonad.
--- 
+--
 -- Swaps focused window with the master window. If focus is in the
 -- master, swap it with the next window in the stack. Focus stays in the
 -- master.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.DwmPromote (
+module XMonad.Actions.DwmPromote (
                                  -- * Usage
-                                 -- $usage 
+                                 -- $usage
                                  dwmpromote
                                 ) where
 
 import XMonad
-import Operations (windows)
-import StackSet
+import XMonad.StackSet
 
 -- $usage
 --
--- To use, modify your Config.hs to:
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- >    import XMonadContrib.DwmPromote
+-- >    import XMonad.Actions.DwmPromote
 --
--- and add a keybinding or substitute promote with dwmpromote:
+-- then add a keybinding or substitute 'dwmpromote' in place of promote:
 --
--- >   , ((modMask,               xK_Return), dwmpromote)
-
--- %import XMonadContrib.DwmPromote
--- %keybind , ((modMask,               xK_Return), dwmpromote)
+-- >   , ((modMask x,               xK_Return), dwmpromote)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
+-- | Swap the focused window with the master window. If focus is in
+--   the master, swap it with the next window in the stack. Focus
+--   stays in the master.
 dwmpromote :: X ()
 dwmpromote = windows $ modify' $
              \c -> case c of

XMonad/Actions/DynamicWorkspaces.hs

@@ -0,0 +1,129 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaces
+-- 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 add and delete workspaces.  Note that you may only
+-- delete a workspace that is already empty.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaces (
+                                         -- * Usage
+                                         -- $usage
+                                         addWorkspace, removeWorkspace,
+                                         withWorkspace,
+                                         selectWorkspace, renameWorkspace,
+                                         toNthWorkspace, withNthWorkspace
+                                       ) where
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet hiding (filter, modify, delete)
+import XMonad.Prompt.Workspace
+import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Util.WorkspaceCompare ( getSortByIndex )
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.DynamicWorkspaces
+--
+-- Then add keybindings like the following:
+--
+-- >   , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)
+-- >   , ((modMask x .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)
+-- >   , ((modMask x, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))
+-- >   , ((modMask x .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))
+-- >   , ((modMask x .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
+--
+-- > -- mod-[1..9]       %! Switch to workspace N
+-- > -- mod-shift-[1..9] %! Move client to workspace N
+-- >    ++
+-- >    zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
+-- >    ++
+-- >    zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+data Wor = Wor String
+
+instance XPrompt Wor where
+    showXPrompt (Wor x) = x
+
+mkCompl :: [String] -> String -> IO [String]
+mkCompl l s = return $ filter (\x -> take (length s) x == s) l
+
+withWorkspace :: XPConfig -> (String -> X ()) -> X ()
+withWorkspace c job = do ws <- gets (workspaces . windowset)
+                         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'
+
+renameWorkspace :: XPConfig -> X ()
+renameWorkspace conf = workspacePrompt conf $ \w ->
+                       windows $ \s -> let sett wk = wk { tag = w }
+                                           setscr scr = scr { workspace = sett $ workspace scr }
+                                           sets q = q { current = setscr $ current q }
+                                       in sets $ removeWorkspace' w s
+
+toNthWorkspace :: (String -> X ()) -> Int -> X ()
+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 sort <- getSortByIndex
+                               ws <- gets (map tag . sort . workspaces . windowset)
+                               case drop wnum ws of
+                                 (w:_) -> windows $ job w
+                                 [] -> return ()
+
+selectWorkspace :: XPConfig -> X ()
+selectWorkspace conf = workspacePrompt conf $ \w ->
+                       do s <- gets windowset
+                          if tagMember w s
+                            then windows $ greedyView w
+                            else addWorkspace w
+
+-- | Add a new workspace with the given name.
+addWorkspace :: String -> X ()
+addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
+
+addHiddenWorkspace :: String -> X ()
+addHiddenWorkspace newtag = do l <- asks (layoutHook . config)
+                               windows (addHiddenWorkspace' newtag l)
+
+-- | Remove the current workspace if it contains no windows.
+removeWorkspace :: X ()
+removeWorkspace = do s <- gets windowset
+                     case s of
+                       StackSet { current = Screen { workspace = torem }
+                                , hidden = (w:_) }
+                           -> do windows $ view (tag w)
+                                 windows (removeWorkspace' (tag torem))
+                       _ -> return ()
+
+addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
+addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
+
+removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
+removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
+                                   , hidden = (w:ws) })
+    | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
+                         , hidden = ws }
+   where meld Nothing Nothing = Nothing
+         meld x Nothing = x
+         meld Nothing x = x
+         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
+removeWorkspace' _ s = s

XMonad/Actions/FindEmptyWorkspace.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.FindEmptyWorkspace
+-- Module      :  XMonad.Actions.FindEmptyWorkspace
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -8,43 +8,38 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Find an empty workspace in XMonad.
+-- Find an empty workspace.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.FindEmptyWorkspace (
+module XMonad.Actions.FindEmptyWorkspace (
     -- * Usage
     -- $usage
     viewEmptyWorkspace, tagToEmptyWorkspace
   ) where
 
-import Control.Monad.State
 import Data.List
 import Data.Maybe ( isNothing )
 
 import XMonad
-import StackSet
-
-import Operations
+import XMonad.StackSet
 
 -- $usage
--- 
--- To use, modify your Config.hs to:
 --
--- >   import XMonadContrib.FindEmptyWorkspace
+-- To use, import this module into your @~\/.xmonad\/xmonad.hs@:
 --
--- and add a keybinding:
+-- >   import XMonad.Actions.FindEmptyWorkspace
 --
---  >   , ((modMask,                xK_m    ), viewEmptyWorkspace)
---  >   , ((modMask .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
+-- and add the desired keybindings, for example:
 --
--- Now you can jump to an empty workspace with mod-m. Mod-shift-m will
--- tag the current window to an empty workspace and view it.
-
--- %import XMonadContrib.FindEmptyWorkspace
--- %keybind , ((modMask,                xK_m    ), viewEmptyWorkspace)
--- %keybind , ((modMask .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
-
+--  >   , ((modMask x,                xK_m    ), viewEmptyWorkspace)
+--  >   , ((modMask x .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
+--
+-- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@
+-- will tag the current window to an empty workspace and view it.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 -- | Find the first hidden empty workspace in a StackSet. Returns
 -- Nothing if all workspaces are in use. Function searches currently

XMonad/Actions/FlexibleManipulate.hs

@@ -2,67 +2,79 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.FlexibleManipulate
+-- Module      :  XMonad.Actions.FlexibleManipulate
 -- Copyright   :  (c) Michael Sloan
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  <mgsloan@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Lets you move and resize floating windows without warping the mouse.
+-- Move and resize floating windows without warping the mouse.
 --
 -----------------------------------------------------------------------------
 
--- Based on the FlexibleResize code by Lukas Mai (Mauke)
+-- Based on the FlexibleResize code by Lukas Mai (mauke).
 
-module XMonadContrib.FlexibleManipulate (
-	-- * Usage
-	-- $usage
-	mouseWindow, discrete, linear, resize, position
+module XMonad.Actions.FlexibleManipulate (
+        -- * Usage
+        -- $usage
+        mouseWindow, discrete, linear, resize, position
 ) where
 
 import XMonad
-import Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
 
 -- $usage
--- Add this import to your Config.hs file:
+-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
 --
--- > import qualified XMonadContrib.FlexibleManipulate as Flex
+-- > import qualified XMonad.Actions.FlexibleManipulate as Flex
 --
--- Set one of the mouse button bindings up like this:
+-- Now set up the desired mouse binding, for example:
 --
--- > mouseBindings = M.fromList
--- >     [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ...
+-- >     , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
 --
--- Flex.linear indicates that positions between the edges and the middle
---    indicate a combination scale\/position.
--- Flex.discrete indicates that there are discrete pick regions. (window
---    is divided by thirds for each axis)
--- Flex.resize performs only resize of the window, based on which quadrant
---    the mouse is in
--- Flex.position is similar to the built-in mouseMoveWindow
+-- * Flex.'linear' indicates that positions between the edges and the
+--   middle indicate a combination scale\/position.
+--
+-- * Flex.'discrete' indicates that there are discrete pick
+--   regions. (The window is divided by thirds for each axis.)
+--
+-- * Flex.'resize' performs only a resize of the window, based on which
+--   quadrant the mouse is in.
+--
+-- * Flex.'position' is similar to the built-in
+--   'XMonad.Operations.mouseMoveWindow'.
 --
 -- You can also write your own function for this parameter. It should take
 -- a value between 0 and 1 indicating position, and return a value indicating
--- the corresponding position if plain Flex.linear was used.
-
--- %import qualified XMonadContrib.FlexibleManipulate as Flex
--- %mousebind , ((modMask, button1), (\\w -> focus w >> Flex.mouseWindow Flex.linear w))
+-- the corresponding position if plain Flex.'linear' was used.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
 
 discrete, linear, resize, position :: Double -> Double
 
+-- | Manipulate the window based on discrete pick regions; the window
+--   is divided into regions by thirds along each axis.
 discrete x | x < 0.33 = 0
            | x > 0.66 = 1
            | otherwise = 0.5
 
+-- | Scale\/reposition the window by factors obtained from the mouse
+--   position by linear interpolation. Dragging precisely on a corner
+--   resizes that corner; dragging precisely in the middle moves the
+--   window without resizing; anything else is an interpolation
+--   between the two.
 linear = id
 
+-- | Only resize the window, based on the window quadrant the mouse is in.
 resize x = if x < 0.5 then 0 else 1
+
+-- | Only reposition the window.
 position = const 0.5
 
+-- | Given an interpolation function, implement an appropriate window
+--   manipulation action.
 mouseWindow :: (Double -> Double) -> Window -> X ()
 mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w
@@ -86,7 +98,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
         (float w)
 
     float w
-    
+
   where
     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
     winAttrs :: WindowAttributes -> [Pnt]
@@ -103,7 +115,7 @@ pairUp (x:y:xs) = (x, y) : (pairUp xs)
 
 mapP :: (a -> b) -> (a, a) -> (b, b)
 mapP f (x, y) = (f x, f y)
-zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) 
+zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
 zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
 
 minP :: Ord a => (a,a) -> (a,a) -> (a,a)

XMonad/Actions/FlexibleResize.hs

@@ -1,40 +1,40 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.FlexibleResize
+-- Module      :  XMonad.Actions.FlexibleResize
 -- Copyright   :  (c) Lukas Mai
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  <l.mai@web.de>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- Lets you resize floating windows from any corner.
+-- Resize floating windows from any corner.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.FlexibleResize (
-	-- * Usage
-	-- $usage
-	XMonadContrib.FlexibleResize.mouseResizeWindow
+module XMonad.Actions.FlexibleResize (
+        -- * Usage
+        -- $usage
+        XMonad.Actions.FlexibleResize.mouseResizeWindow
 ) where
 
 import XMonad
-import Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
 import Foreign.C.Types
 
 -- $usage
--- Put something like this in your Config.hs file:
+-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:
 --
--- > import qualified XMonadContrib.FlexibleResize as Flex
--- > mouseBindings = M.fromList
--- >     [ ...
--- >     , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) ]
-
--- %import qualified XMonadContrib.FlexibleResize as Flex
--- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w))
+-- > import qualified XMonad.Actions.FlexibleResize as Flex
+--
+-- Then add an appropriate mouse binding:
+--
+-- >     , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w))
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
 
+-- | Resize a floating window from whichever corner the mouse is
+--   closest to.
 mouseResizeWindow :: Window -> X ()
 mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w

XMonad/Actions/FloatKeys.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : XMonadContrib.FloatKeys
+-- Module       : XMonad.Actions.FloatKeys
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -11,7 +11,7 @@
 -- Move and resize floating windows.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.FloatKeys (
+module XMonad.Actions.FloatKeys (
                 -- * Usage
                 -- $usage
                 keysMoveWindow,
@@ -19,44 +19,26 @@ module XMonadContrib.FloatKeys (
                 keysResizeWindow,
                 keysAbsResizeWindow) where
 
-import Operations
 import XMonad
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
 
 -- $usage
--- > import XMonadContrib.FloatKeys
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- >  , ((modMask,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1))) 
--- >  , ((modMask,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1))) 
--- >  , ((modMask .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752))) 
--- >  , ((modMask .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752))) 
--- >  , ((modMask,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
+-- >    import XMonad.Actions.FloatKeys
 --
+-- Then add appropriate key bindings, for example:
 --
--- keysMoveWindow (dx, dy) moves the window by dx pixels to the right and dy pixels down
---
--- keysMoveWindowTo (x, y) (gx, gy) moves the window relative point (gx, gy) to the point (x,y)
---      where (gx,gy) gives a position relative to the window border, i.e.
---      gx = 0 is the left border and gx = 1 the right border
---      gy = 0 is the top border  and gy = 1 the bottom border
---
---      examples on a 1024x768 screen: keysMoveWindowTo (512,384) (1%2, 1%2) centers the window on screen
---                                     keysMoveWindowTo (1024,0) (1, 0) puts it into the top right corner
---
--- keysResizeWindow (dx, dy) (gx, gy) changes the width by dx and the height by dy leaving the window
---      relative point (gx, gy) fixed
---
---      examples: keysResizeWindow (10, 0) (0, 0) makes the window 10 pixels larger to the right
---                keysResizeWindow (10, 0) (0, 1%2) does the same, unless sizeHints are applied
---                keysResizeWindow (10, 10) (1%2, 1%2) adds 5 pixels on each side
---                keysResizeWindow (-10, -10) (0, 1) shrinks the window in direction of the bottom-left corner
---              
---  keysAbsResizeWindow (dx, dy) (ax, ay) changes the width by dx and the height by dy leaving the screen
---      absolut point (ax, ay) fixed
---
---      examples on a 1024x768 screen: keysAbsResizeWindow (10, 10) (0, 0) enlarge the window and if it is not in the top-left corner it will also be moved away
+-- >  , ((modMask x,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
+-- >  , ((modMask x,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
+-- >  , ((modMask x .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
+-- >  , ((modMask x .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
+-- >  , ((modMask x,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
 --
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
+--   right and @dy@ pixels down.
 keysMoveWindow :: D -> Window -> X ()
 keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w
@@ -65,6 +47,16 @@ keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
                         (fromIntegral (fromIntegral (wa_y wa) + dy))
     float w
 
+-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative
+--   point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a
+--   position relative to the window border, i.e.  @gx = 0@ is the left
+--   border, @gx = 1@ is the right border, @gy = 0@ is the top border, and
+--   @gy = 1@ the bottom border.
+--
+--   For example, on a 1024x768 screen:
+--
+-- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen
+-- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner
 keysMoveWindowTo :: P -> G -> Window -> X ()
 keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
     io $ raiseWindow d w
@@ -76,9 +68,26 @@ keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
 type G = (Rational, Rational)
 type P = (Position, Position)
 
+-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@
+--   and the height by @dy@, leaving the window-relative point @(gx,
+--   gy)@ fixed.
+--
+--   For example:
+--
+-- > keysResizeWindow (10, 0) (0, 0)      -- make the window 10 pixels larger to the right
+-- > keysResizeWindow (10, 0) (0, 1%2)    -- does the same, unless sizeHints are applied
+-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side
+-- > keysResizeWindow (-10, -10) (0, 1)   -- shrink the window in direction of the bottom-left corner
 keysResizeWindow :: D -> G -> Window -> X ()
 keysResizeWindow = keysMoveResize keysResizeWindow'
 
+-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@
+--   and the height by @dy@, leaving the screen absolute point @(ax,
+--   ay)@ fixed.
+--
+--   For example:
+--
+-- > keysAbsResizeWindow (10, 10) (0, 0)   -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.
 keysAbsResizeWindow :: D -> D -> Window -> X ()
 keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
 
@@ -105,7 +114,7 @@ keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
     sh <- io $ getWMNormalHints d w
     let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
         wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)
-        (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize 
+        (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize
     io $ resizeWindow d w `uncurry` wn_dim
     io $ moveWindow d w `uncurry` wn_pos
     float w

XMonad/Actions/FocusNth.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : XMonadContrib.FocusNth
+-- Module       : XMonad.Actions.FocusNth
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -8,41 +8,43 @@
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- Focus the nth window on the screen.
+-- Focus the nth window of the current workspace.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.FocusNth (
+module XMonad.Actions.FocusNth (
                  -- * Usage
                  -- $usage
                  focusNth) where
 
-import StackSet
-import Operations
+import XMonad.StackSet
 import XMonad
 
 -- $usage
--- > import XMonadContrib.FocusNth
-
+-- Add the import to your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.FocusNth
+--
+-- Then add appropriate keybindings, for example:
+--
 -- > -- mod4-[1..9] @@ Switch to window N
--- > ++ [((mod4Mask, k), focusNth i)
+-- > ++ [((modMask x, k), focusNth i)
 -- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
--- %import XMonadContrib.FocusNth
--- %keybdindextra ++
--- %keybdindextra -- mod4-[1..9] @@ Switch to window N
--- %keybdindextra [((mod4Mask, k), focusNth i)
--- %keybdindextra     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
-
+-- | Give focus to the nth window of the current workspace.
 focusNth :: Int -> X ()
 focusNth = windows . modify' . focusNth'
 
 focusNth' :: Int -> Stack a -> Stack a
-focusNth' n s@(Stack _ ls rs)	| (n < 0) || (n > length(ls) + length(rs)) = s
-				| otherwise = listToStack n (integrate s)
+focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
+                              | otherwise = listToStack n (integrate s)
 
 listToStack :: Int -> [a] -> Stack a
 listToStack n l = Stack t ls rs
-	where	(t:rs)	= drop n l
-		ls	= reverse (take n l)
+ where
+    (t:rs)    = drop n l
+    ls        = reverse (take n l)
 
 

XMonad/Actions/MouseGestures.hs

@@ -0,0 +1,137 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MouseGestures
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Support for simple mouse gestures.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.MouseGestures (
+    -- * Usage
+    -- $usage
+    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
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.MouseGestures
+-- > import qualified XMonad.StackSet as W
+--
+-- then add an appropriate mouse binding:
+--
+-- >     , ((modMask x .|. shiftMask, button3), mouseGesture gestures)
+--
+-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on
+-- windows, for example:
+--
+-- >     gestures = M.fromList
+-- >         [ ([], focus)
+-- >         , ([U], \w -> focus w >> windows W.swapUp)
+-- >         , ([D], \w -> focus w >> windows W.swapDown)
+-- >         , ([R, D], \_ -> sendMessage NextLayout)
+-- >         ]
+--
+-- This is just an example, of course; you can use any mouse button and
+-- gesture definitions you want.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+type Pos = (Position, Position)
+
+delta :: Pos -> Pos -> Position
+delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
+    where
+    d a b = abs (a - b)
+
+dir :: Pos -> Pos -> Direction
+dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
+    where
+    trans :: Double -> Direction
+    trans x
+        | rg (-3/4) (-1/4) x = D
+        | rg (-1/4)  (1/4) x = R
+        | rg  (1/4)  (3/4) x = U
+        | otherwise          = L
+    rg a z x = a <= x && x < z
+
+gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X ()
+gauge hook op st nx ny = do
+    let np = (nx, ny)
+    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
+    significant a b = delta a b >= 10
+
+-- | @'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
+    (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
+
+-- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two
+-- callback functions for passing to 'mouseGestureH'. The move hook will
+-- collect mouse movements (and return the current gesture as a list); the end
+-- hook will return a list of the completed gesture, which you can access with
+-- 'Control.Monad.>>='.
+mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction])
+mkCollect = liftIO $ do
+    acc <- newIORef []
+    let
+        mov d = liftIO $ do
+            ds <- readIORef acc
+            let ds' = d : ds
+            writeIORef acc ds'
+            return $ reverse ds'
+        end = liftIO $ do
+            ds <- readIORef acc
+            writeIORef acc []
+            return $ reverse ds
+    return (mov, end)

XMonad/Actions/MouseResize.hs

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

XMonad/Actions/NoBorders.hs

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

XMonad/Actions/PerWorkspaceKeys.hs

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

XMonad/Actions/Promote.hs

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

XMonad/Actions/RotSlaves.hs

@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.RotSlaves
+-- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
+-- License      : BSD3-style (see LICENSE)
+--
+-- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Rotate all windows except the master window and keep the focus in
+-- place.
+-----------------------------------------------------------------------------
+module XMonad.Actions.RotSlaves (
+        -- $usage
+        rotSlaves', rotSlavesUp, rotSlavesDown,
+        rotAll', rotAllUp, rotAllDown
+        ) where
+
+import XMonad.StackSet
+import XMonad
+
+-- $usage
+--
+-- To use this module, import it with:
+--
+-- > import XMonad.Actions.RotSlaves
+--
+-- and add whatever keybindings you would like, for example:
+--
+-- > , ((modMask x .|. shiftMask, xK_Tab   ), rotSlavesUp)
+--
+-- This operation will rotate all windows except the master window,
+-- while the focus stays where it is. It is useful together with the
+-- TwoPane layout (see "XMonad.Layout.TwoPane").
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Rotate the windows in the current stack, excluding the first one
+--   (master).
+rotSlavesUp,rotSlavesDown :: X ()
+rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
+rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
+
+-- | The actual rotation, as a pure function on the window stack.
+rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
+rotSlaves' _ s@(Stack _ [] []) = s
+rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus
+rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise
+    where  (master:ws)     = integrate s
+           (revls',t':rs') = splitAt (length ls) (master:(f ws))
+
+-- | Rotate all the windows in the current stack.
+rotAllUp,rotAllDown :: X ()
+rotAllUp   = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
+rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
+
+-- | The actual rotation, as a pure function on the window stack.
+rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
+rotAll' f s = Stack r (reverse revls) rs
+    where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))

XMonad/Actions/Search.hs

@@ -0,0 +1,215 @@
+{- |
+ Module      :  XMonad.Actions.Search
+ Copyright   :  (C) 2007 Gwern Branwen
+ License     :  None; public domain
+
+ Maintainer  :  <gwern0@gmail.com>
+ Stability   :  unstable
+ Portability :  unportable
+
+ A module for easily running Internet searches on web sites through xmonad.
+ Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
+
+ Additional sites welcomed.
+-}
+module XMonad.Actions.Search (      -- * Usage
+                                    -- $usage
+                                 search,
+                                 simpleEngine,
+                                 promptSearch,
+                                 selectSearch,
+
+                                 amazon,
+                                 google,
+                                 hoogle,
+                                 imdb,
+                                 maps,
+                                 mathworld,
+                                 scholar,
+                                 wayback,
+                                 wikipedia
+
+                                    -- * Use case: searching with a submap
+                                    -- $tip
+
+                          ) where
+
+import Data.Char (chr, ord, isAlpha, isMark, isDigit)
+import Numeric (showIntAtBase)
+import XMonad (X(), MonadIO)
+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())
+import XMonad.Prompt.Shell (getShellCompl)
+import XMonad.Util.Run (safeSpawn)
+import XMonad.Util.XSelection (getSelection)
+
+{- $usage
+
+   This module is intended to allow easy access to databases on the
+   Internet through xmonad's interface. The idea is that one wants to
+   run a search but the query string and the browser to use must come
+   from somewhere. There are two places the query string can come from
+   - the user can type it into a prompt which pops up, or the query
+   could be available already in the X Windows copy\/paste buffer
+   (perhaps you just highlighted the string of interest).
+
+   Thus, there are two main functions: 'promptSearch', and
+   'selectSearch' (implemented using the more primitive 'search'). To
+   each of these is passed an engine function; this is a function that
+   knows how to search a particular site.
+
+   For example, the 'google' function knows how to search Google, and
+   so on. You pass 'promptSearch' and 'selectSearch' the engine you
+   want, the browser you want, and anything special they might need;
+   this whole line is then bound to a key of you choosing in your
+   xmonad.hs. For specific examples, see each function.  This module
+   is easily extended to new sites by using '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.
+data Search = Search
+instance XPrompt Search where
+    showXPrompt Search = "Search: "
+
+-- | Escape the search string so search engines understand it.
+-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
+-- but then that'd be hard enough to copy-and-paste we'd need to depend on 'network'.
+escape :: String -> String
+escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
+         where -- Copied from Network.URI.
+           escapeURIString ::
+               (Char -> Bool)      -- a predicate which returns 'False' if should escape
+               -> String           -- the string to process
+               -> String           -- the resulting URI string
+           escapeURIString p s = concatMap (escapeURIChar p) s
+           escapeURIChar :: (Char->Bool) -> Char -> String
+           escapeURIChar p c
+               | p c       = [c]
+               | otherwise = '%' : myShowHex (ord c) ""
+               where
+                 myShowHex :: Int -> ShowS
+                 myShowHex n r =  case showIntAtBase 16 (toChrHex) n r of
+                                    []  -> "00"
+                                    [ch] -> ['0',ch]
+                                    cs  -> cs
+                 toChrHex d
+                   | d < 10    = chr (ord '0' + fromIntegral d)
+                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+
+type Browser      = FilePath
+type Query        = String
+type SearchEngine = String -> String
+
+{- | 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
+   appends it to the base. You can easily define a new engine locally using simpleEngine
+   without needing to modify Search.hs:
+
+   > newEngine = simpleEngine "http://site.com/search="
+
+   The important thing is that the site has a interface which accepts the query
+   string as part of the URL. Alas, the exact URL to feed simpleEngine varies
+   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 :: Query -> SearchEngine
+simpleEngine site query = site ++ escape query
+
+-- 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
+   method at <http://web.archive.org/collections/web/advanced.html> to get the
+   latest backup. -}
+
+{- | 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)
+
+-}
+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,
+   passes it to a given searchEngine and opens it in the given browser. Example:
+
+> , ((modm .|. shiftMask, xK_g), selectSearch "firefox" google)
+
+-}
+selectSearch :: MonadIO m => Browser -> SearchEngine -> m ()
+selectSearch browser searchEngine = search browser searchEngine =<< getSelection

XMonad/Actions/SimpleDate.hs

@@ -1,9 +1,9 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.SimpleDate
+-- Module      :  XMonad.Actions.SimpleDate
 -- Copyright   :  (c) Don Stewart 2007
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  dons@cse.unsw.edu.au
 -- Stability   :  stable
 -- Portability :  portable
@@ -13,27 +13,28 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.SimpleDate (
+module XMonad.Actions.SimpleDate (
                                  -- * Usage
                                  -- $usage
                                  date
                                 ) where
 
-import XMonad
+import XMonad.Core
+import XMonad.Util.Run
 
 -- $usage
--- To use, modify your Config.hs to:
+-- To use, import this module into @~\/.xmonad\/xmonad.hs@:
 --
--- >     import XMonadContrib.SimpleDate
+-- >     import XMonad.Actions.SimpleDate
 --
--- and add a keybinding:
+-- and add a keybinding, for example:
 --
--- >    , ((modMask,               xK_d     ), date)
+-- >    , ((modMask x,               xK_d     ), date)
 --
--- a popup date menu will now be bound to mod-d
-
--- %import XMonadContrib.SimpleDate
--- %keybind , ((modMask,               xK_d     ), date)
+-- In this example, a popup date menu will now be bound to @mod-d@.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 date :: X ()
-date = spawn "(date; sleep 10) | dzen2"
+date = unsafeSpawn "(date; sleep 10) | dzen2"

XMonad/Actions/SinkAll.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : XmonadContrib.SinkAll
+-- Module       : XMonad.Actions.SinkAll
 -- License      : BSD3-style (see LICENSE)
 -- Stability    : unstable
 -- Portability  : unportable
@@ -9,28 +9,32 @@
 -- workspace back into tiling.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.SinkAll (
+module XMonad.Actions.SinkAll (
     -- * Usage
     -- $usage
     sinkAll) where
 
-import Operations
 import XMonad
-import StackSet
-
-import Graphics.X11.Xlib
+import XMonad.StackSet
 
 -- $usage
--- > import XMonadContrib.SinkAll
--- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ]
-
--- %import XMonadContrib.SinkAll
--- %keybind , ((modMask .|. shiftMask, xK_t), sinkAll)
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.SinkAll
+--
+-- then add a keybinding; for example:
+--
+--     , ((modMask x .|. shiftMask, xK_t), sinkAll)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
+-- | Un-float all floating windows on the current workspace.
 sinkAll :: X ()
 sinkAll = withAll sink
 
--- Apply a function to all windows on current workspace.
+-- | Apply a function to all windows on current workspace.
 withAll :: (Window -> WindowSet -> WindowSet) -> X ()
 withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws
                              in foldr f ws all'

XMonad/Actions/Submap.hs

@@ -1,70 +1,76 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Submap
+-- Module      :  XMonad.Actions.Submap
 -- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  Jason Creighton <jcreigh@gmail.com>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- A module that allows the user to create a sub-mapping of keys bindings.
+-- A module that allows the user to create a sub-mapping of key bindings.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Submap (
+module XMonad.Actions.Submap (
                              -- * Usage
                              -- $usage
                              submap
                             ) where
 
-import Control.Monad.Reader
-
-import XMonad
-import Operations (cleanMask)
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
+import XMonad hiding (keys)
 import qualified Data.Map as M
+import Control.Monad.Fix (fix)
 
 {- $usage
+
+
+
+
+First, import this module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.Submap
+
 Allows you to create a sub-mapping of keys. Example:
 
->    , ((modMask, xK_a), submap . M.fromList $
+>    , ((modMask x, xK_a), submap . M.fromList $
 >        [ ((0, xK_n),     spawn "mpc next")
 >        , ((0, xK_p),     spawn "mpc prev")
 >        , ((0, xK_z),     spawn "mpc random")
 >        , ((0, xK_space), spawn "mpc toggle")
 >        ])
 
-So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the
-submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are,
-of course, free to use any combination of modifiers in the submapping. However,
-anyModifier will not work, because that is a special value passed to XGrabKey()
-and not an actual modifier.
+So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to
+trigger the submapping) and then 'n' to run that action. (0 means \"no
+modifier\"). You are, of course, free to use any combination of
+modifiers in the submapping. However, anyModifier will not work,
+because that is a special value passed to XGrabKey() and not an actual
+modifier.
+
+For detailed instructions on editing your key bindings, see
+"XMonad.Doc.Extending#Editing_key_bindings".
+
 -}
 
--- %import XMonadContrib.Submap
--- %keybind , ((modMask, xK_a), submap . M.fromList $
--- %keybind     [ ((0, xK_n),     spawn "mpc next")
--- %keybind     , ((0, xK_p),     spawn "mpc prev")
--- %keybind     , ((0, xK_z),     spawn "mpc random")
--- %keybind     , ((0, xK_space), spawn "mpc toggle")
--- %keybind     ])
-
+-- | Given a 'Data.Map.Map' from key bindings to X () actions, return
+--   an action which waits for a user keypress and executes the
+--   corresponding action, or does nothing if the key is not found in
+--   the map.
 submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
 submap keys = do
     XConf { theRoot = root, display = d } <- ask
 
     io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
 
-    keyspec <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
+    (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
         maskEvent d keyPressMask p
         KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
         keysym <- keycodeToKeysym d code 0
         if isModifierKey keysym
             then nextkey
-            else return (cleanMask m, keysym)
+            else return (m, keysym)
 
     io $ ungrabKeyboard d currentTime
 
-    whenJust (M.lookup keyspec keys) id
+    m' <- cleanMask m
+    whenJust (M.lookup (m', s) keys) id

XMonad/Actions/SwapWorkspaces.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.SwapWorkspaces
+-- Module      :  XMonad.Actions.SwapWorkspaces
 -- Copyright   :  (c) Devin Mullins <me@twifkak.com>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -13,40 +13,39 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.SwapWorkspaces (
+module XMonad.Actions.SwapWorkspaces (
                                      -- * Usage
                                      -- $usage
                                      swapWithCurrent,
                                      swapWorkspaces
                                     ) where
 
-import StackSet
+import XMonad.StackSet
+
 
 -- $usage
--- Add this import to your Config.hs:
+-- Add this import to your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.SwapWorkspaces
+-- > import XMonad.Actions.SwapWorkspaces
 --
--- Throw this in your keys definition:
+-- Then throw something like this in your keys definition:
 --
 -- > ++
--- > [((modMask .|. controlMask, k), windows $ swapWithCurrent i)
+-- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i)
 -- >     | (i, k) <- zip workspaces [xK_1 ..]]
-
--- %import XMonadContrib.SwapWorkspaces
--- %keybindlist ++
--- %keybindlist [((modMask .|. controlMask, k), windows $ swapWithCurrent i)
--- %keybindlist     | (i, k) <- zip workspaces [xK_1 ..]]
 --
 -- After installing this update, if you're on workspace 1, hitting mod-ctrl-5
 -- will swap workspaces 1 and 5.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 -- | Swaps the currently focused workspace with the given workspace tag, via
 --   @swapWorkspaces@.
 swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
 swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s
 
--- | Takes two workspace tags and an existing StackSet and returns a new
+-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
 --   one with the two corresponding workspaces' tags swapped.
 swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
 swapWorkspaces t1 t2 = mapWorkspace swap

XMonad/Actions/TagWindows.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : XMonadContrib.TagWindows
+-- Module       : XMonad.Actions.TagWindows
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -11,7 +11,7 @@
 -- Functions for tagging windows and selecting them by tags.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.TagWindows (
+module XMonad.Actions.TagWindows (
                  -- * Usage
                  -- $usage
                  addTag, delTag, unTag,
@@ -26,57 +26,54 @@ module XMonadContrib.TagWindows (
                  ) where
 
 import Data.List (nub,concat,sortBy)
+import Control.Monad
 
-import Control.Monad.State
-import StackSet hiding (filter)
-import Operations (windows, withFocused)
+import XMonad.StackSet hiding (filter)
 
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
-import XMonadContrib.XPrompt
-import XMonad
+import XMonad.Prompt
+import XMonad hiding (workspaces)
 
 -- $usage
--- 
--- To use window tags add in your Config.hs:
 --
--- > import XMonadContrib.TagWindows
--- > import XMonadContrib.XPrompt    -- to use tagPrompt
--- 
--- and add keybindings like as follows:
+-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
 --
--- >   , ((modMask,                 xK_f  ), withFocused (addTag "abc")) 
--- >   , ((modMask .|. controlMask, xK_f  ), withFocused (delTag "abc")) 
--- >   , ((modMask .|. shiftMask,   xK_f  ), withTaggedGlobal "abc" sink) 
--- >   , ((modMask,                 xK_d  ), withTaggedP "abc" (shiftWin "2")) 
--- >   , ((modMask .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere) 
--- >   , ((modMask .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc") 
--- >   , ((modMask,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s))) 
--- >   , ((modMask .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)
--- >   , ((modMask .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
--- >   , ((modWinMask,              xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2")))
--- >   , ((modWinMask .|. shiftMask, xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
--- >   , ((modWinMask .|. controlMask, xK_g), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s)) 
+-- > import XMonad.Actions.TagWindows
+-- > import XMonad.Prompt    -- to use tagPrompt
 --
--- NOTE: Tags are saved as space seperated string and split with 'unwords' thus
---       if you add a tag "a b" the window will have the tags "a" and "b" but not "a b".
+-- and add keybindings such as the following:
+--
+-- >   , ((modMask x,                 xK_f  ), withFocused (addTag "abc"))
+-- >   , ((modMask x .|. controlMask, xK_f  ), withFocused (delTag "abc"))
+-- >   , ((modMask x .|. shiftMask,   xK_f  ), withTaggedGlobal "abc" sink)
+-- >   , ((modMask x,                 xK_d  ), withTaggedP "abc" (shiftWin "2"))
+-- >   , ((modMask x .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)
+-- >   , ((modMask x .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")
+-- >   , ((modMask x,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))
+-- >   , ((modMask x .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)
+-- >   , ((modMask x .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
+-- >   , ((modWinMask,                xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2")))
+-- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
+-- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s))
+--
+-- NOTE: Tags are saved as space separated strings and split with
+--       'unwords'. Thus if you add a tag \"a b\" the window will have
+--       the tags \"a\" and \"b\" but not \"a b\".
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
--- %import XMonadContrib.TagWindows
--- %import XMonadContrib.XPrompt        -- to use tagPrompt
-
--- set multiple tags for a window at once (overriding any previous tags)
+-- | set multiple tags for a window at once (overriding any previous tags)
 setTags :: [String] -> Window -> X ()
 setTags = setTag . unwords
 
--- set a tag for a window (overriding any previous tags)
--- writes it to the "_XMONAD_TAGS" window property
+-- | set a tag for a window (overriding any previous tags)
+--   writes it to the \"_XMONAD_TAGS\" window property
 setTag :: String -> Window -> X ()
 setTag s w = withDisplay $ \d ->
     io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s
 
--- read all tags of a window
--- reads from the "_XMONAD_TAGS" window property
+-- | read all tags of a window
+--   reads from the \"_XMONAD_TAGS\" window property
 getTags :: Window -> X [String]
 getTags w = withDisplay $ \d ->
     io $ catch (internAtom d "_XMONAD_TAGS" False >>=
@@ -85,36 +82,35 @@ getTags w = withDisplay $ \d ->
                (\_ -> return [[]])
     >>= return . words . unwords
 
--- check a window for the given tag
+-- | check a window for the given tag
 hasTag :: String -> Window -> X Bool
-hasTag s w = (s `elem`) `liftM` getTags w
+hasTag s w = (s `elem`) `fmap` getTags w
 
--- add a tag to the existing ones
+-- | add a tag to the existing ones
 addTag :: String -> Window -> X ()
 addTag s w = do
     tags <- getTags w
     if (s `notElem` tags) then setTags (s:tags) w else return ()
 
--- remove a tag from a window, if it exists
+-- | remove a tag from a window, if it exists
 delTag :: String -> Window -> X ()
 delTag s w = do
     tags <- getTags w
     setTags (filter (/= s) tags) w
 
--- remove all tags
+-- | remove all tags
 unTag :: Window -> X ()
 unTag = setTag ""
 
--- Move the focus in a group of windows, which share the same given tag.
--- The Global variants move through all workspaces, whereas the other
--- ones operate only on the current workspace
+-- | Move the focus in a group of windows, which share the same given tag.
+--   The Global variants move through all workspaces, whereas the other
+--   ones operate only on the current workspace
 focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()
 focusUpTagged         = focusTagged' (reverse . wsToList)
 focusDownTagged       = focusTagged' wsToList
 focusUpTaggedGlobal   = focusTagged' (reverse . wsToListGlobal)
 focusDownTaggedGlobal = focusTagged' wsToListGlobal
 
--- 
 wsToList :: (Ord i) => StackSet i l a s sd -> [a]
 wsToList ws = crs ++ cls
     where
@@ -140,7 +136,7 @@ findM _ []      = return Nothing
 findM p (x:xs)  = do b <- p x
                      if b then return (Just x) else findM p xs
 
--- apply a pure function to windows with a tag
+-- | apply a pure function to windows with a tag
 withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
 withTaggedP       t f = withTagged'       t (winMap f)
 withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)
@@ -191,15 +187,9 @@ tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset)
 tagDelPrompt :: XPConfig -> X ()
 tagDelPrompt c = do
   sc <- tagDelComplList
-  if (sc /= []) 
+  if (sc /= [])
     then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
     else return ()
 
 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/Warp.hs

@@ -1,55 +1,56 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Warp
+-- Module      :  XMonad.Actions.Warp
 -- Copyright   :  (c) daniel@wagner-home.com
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  daniel@wagner-home.com
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- This can be used to make a keybinding that warps the pointer to a given
--- window or screen.
+-- Warp the pointer to a given window or screen.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Warp (
+module XMonad.Actions.Warp (
                            -- * Usage
                            -- $usage
-                           warpToScreen, 
+                           warpToScreen,
                            warpToWindow
                           ) where
 
 import Data.Ratio
 import Data.List
-import Control.Monad.RWS
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Operations
 import XMonad
-import StackSet as W
+import XMonad.StackSet as W
 
 {- $usage
-This can be used to make a keybinding that warps the pointer to a given
-window or screen.  For example, I've added the following keybindings to
-my Config.hs:
+You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 
-> , ((modMask,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
-> 
+> import XMonad.Actions.Warp
+
+then add appropriate keybindings to warp the pointer; for example:
+
+> , ((modMask x,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
+>
 >-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
->   
->   [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2))
+>
+>   [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2))
 >       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
 
 Note that warping to a particular screen may change the focus.
+
+'warpToScreen' and 'warpToWindow' can be used in a variety of
+ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,
+which moves the mouse pointer to a corner; you could define:
+
+> banish :: X ()
+> banish = warpToWindow 1 1 -- lower left
+
 -}
 
--- %import XMonadContrib.Warp
--- %keybind , ((modMask,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
--- %keybindlist ++
--- %keybindlist -- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
--- %keybindlist [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2))
--- %keybindlist     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 fraction :: (Integral a, Integral b) => Rational -> a -> b
 fraction f x = floor (f * fromIntegral x)
@@ -57,6 +58,8 @@ fraction f x = floor (f * fromIntegral x)
 warp :: Window -> Position -> Position -> X ()
 warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
 
+-- | Warp the pointer to a given position relative to the currently
+--   focused window.  Top left = (0,0), bottom right = (1,1).
 warpToWindow :: Rational -> Rational -> X ()
 warpToWindow h v =
     withDisplay $ \d ->
@@ -64,6 +67,8 @@ warpToWindow h v =
             wa <- io $ getWindowAttributes d w
             warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
 
+-- | Warp the pointer to the given position (top left = (0,0), bottom
+--   right = (1,1)) on the given screen.
 warpToScreen :: ScreenId -> Rational -> Rational -> X ()
 warpToScreen n h v = do
     root <- asks theRoot

XMonad/Actions/WindowBringer.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.WindowBringer
+-- Module      :  XMonad.Actions.WindowBringer
 -- Copyright   :  Devin Mullins <me@twifkak.com>
 -- License     :  BSD-style (see LICENSE)
 --
@@ -14,38 +14,35 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.WindowBringer (
+module XMonad.Actions.WindowBringer (
                                     -- * Usage
                                     -- $usage
                                     gotoMenu, bringMenu, windowMapWith
                                    ) where
 
-import Control.Monad.State (gets)
 import Data.Char (toLower)
 import qualified Data.Map as M
-import Graphics.X11.Xlib (Window())
 
-import Operations (windows)
-import qualified StackSet as W
-import XMonad (X)
+import qualified XMonad.StackSet as W
+import XMonad
 import qualified XMonad as X
-import XMonadContrib.Dmenu (dmenuMap)
-import XMonadContrib.NamedWindows (getName)
+import XMonad.Util.Dmenu (dmenuMap)
+import XMonad.Util.NamedWindows (getName)
 
 -- $usage
 --
--- Place in your Config.hs:
+-- Import the module into your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.WindowBringer
+-- > import XMonad.Actions.WindowBringer
 --
--- and in the keys definition:
+-- and define appropriate key bindings:
 --
--- > , ((modMask .|. shiftMask, xK_g     ), gotoMenu)
--- > , ((modMask .|. shiftMask, xK_b     ), bringMenu)
+-- > , ((modMask x .|. shiftMask, xK_g     ), gotoMenu)
+-- > , ((modMask x .|. shiftMask, xK_b     ), bringMenu)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
--- %import XMonadContrib.WindowBringer
--- %keybind , ((modMask .|. shiftMask, xK_g     ), gotoMenu)
--- %keybind , ((modMask .|. shiftMask, xK_b     ), bringMenu)
 
 -- | Pops open a dmenu with window titles. Choose one, and you will be
 --   taken to the corresponding workspace.
@@ -65,8 +62,8 @@ bringMenu = windowMap >>= actionMenu (windows . bringWindow)
 actionMenu :: (a -> X ()) -> M.Map String a -> X ()
 actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action
 
--- | Generates a Map from window name to <whatever you specify>. For use with
---   dmenuMap.
+-- | Generates a Map from window name to \<whatever you specify\>. For
+--   use with dmenuMap.
 windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a)
 windowMapWith value = do -- TODO: extract the pure, creamy center.
   ws <- gets X.windowset

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/Config/Arossato.hs

@@ -0,0 +1,189 @@
+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.Arossato
+-- Copyright   :  (c) Andrea Rossato 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- This module specifies my xmonad defaults.
+--
+------------------------------------------------------------------------
+
+module XMonad.Config.Arossato
+    ( -- * Usage
+      -- $usage
+      arossatoConfig
+    ) where
+
+import qualified Data.Map as M
+import System.IO (hPutStrLn)
+
+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
+-- @~\/.xmonad\/xmonad.hs@ like this:
+--
+-- > module Main (main) where
+-- >
+-- > import XMonad
+-- > import XMonad.Config.Arossato (arossatoConfig)
+-- >
+-- > main :: IO ()
+-- > 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
+-- @~\/.xmonad\/xmonad.hs@ and:
+--
+-- 1. Change the module name from
+--
+-- > module XMonad.Config.Arossato
+-- >     ( -- * Usage
+-- >       -- $usage
+-- >       arossatoConfig
+-- >     ) where
+--
+-- to
+--
+-- > module Main where
+--
+-- 2. Add a line like:
+--
+-- > main = xmonad =<< arossatoConfig
+--
+-- 3. Start playing with the configuration options...;)
+
+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            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
+         , manageHook         = newManageHook
+         , layoutHook         = eventHook ServerMode $
+                                avoidStruts $
+                                decorated        |||
+                                noBorders mytabs |||
+                                otherLays
+         , terminal           = "urxvt +sb"
+         , normalBorderColor  = "white"
+         , focusedBorderColor = "black"
+         , keys               = newKeys
+         , focusFollowsMouse  = False
+         }
+    where
+      -- layouts
+      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 =? "win"          --> doF (W.shift "doc") -- xpdf
+                                 , resource =? "firefox-bin"  --> doF (W.shift "web")
+                                 ]
+      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
+      delKeys x  = foldr M.delete           (defKeys x) (toRemove x)
+      newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)
+      -- remove some of the default key bindings
+      toRemove x =
+          [ (modMask x              , xK_j)
+          , (modMask x              , xK_k)
+          , (modMask x              , xK_p)
+          , (modMask x .|. shiftMask, xK_p)
+          , (modMask x .|. shiftMask, xK_q)
+          , (modMask x              , xK_q)
+          ] ++
+          -- I want modMask .|. shiftMask 1-9 to be free!
+          [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]
+      -- These are my personal key bindings
+      toAdd x   =
+          [ ((modMask x              , xK_F12   ), xmonadPrompt      defaultXPConfig     )
+          , ((modMask x              , xK_F3    ), shellPrompt       defaultXPConfig     )
+          , ((modMask x              , xK_F4    ), sshPrompt         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                   )
+          , ((modMask x              , xK_Left  ), windows W.focusUp                     )
+          -- other stuff: launch some useful utilities
+          , ((modMask x              , xK_F2    ), spawn "urxvt -fg white -bg black +sb" )
+          , ((modMask x .|. shiftMask, xK_F4    ), spawn "~/bin/dict.sh"                 )
+          , ((modMask x .|. shiftMask, xK_F5    ), spawn "~/bin/urlOpen.sh"              )
+          , ((modMask x .|. shiftMask, xK_t     ), spawn "~/bin/teaTime.sh"              )
+          , ((modMask x              , xK_c     ), kill                                  )
+          , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN   1 )         )
+          , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1))         )
+          -- commands fo the Magnifier layout
+          , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)
+          , ((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)
+           | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]
+          ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]
+          ]

XMonad/Config/Dons.hs

@@ -0,0 +1,28 @@
+--------------------------------------------------------------------
+-- |
+-- Module    : XMonad.Config.Dons
+-- Copyright : (c) Galois, Inc. 2007
+-- License   : BSD3
+--
+-- Maintainer: Don Stewart <dons@galois.com>
+--
+-- An example, simple configuration file.
+--
+--------------------------------------------------------------------
+
+module XMonad.Config.Dons where
+
+import XMonad
+import XMonad.Hooks.DynamicLog
+import XMonad.Layout.NoBorders
+
+donsMain :: IO ()
+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

@@ -0,0 +1,183 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
+-----------------------------------------------------------------------------
+-- |
+-- Copyright   :  (c) Spencer Janssen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+------------------------------------------------------------------------
+
+module XMonad.Config.Droundy ( config, mytab ) where
+
+import XMonad hiding (keys, config, (|||))
+import qualified XMonad (keys)
+import XMonad.Config ( defaultConfig )
+
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+import System.Exit ( exitWith, ExitCode(ExitSuccess) )
+
+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.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 ( defaultXPConfig, font, height, XPConfig )
+import XMonad.Prompt.Layout ( layoutPrompt )
+import XMonad.Prompt.Shell ( shellPrompt )
+
+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 ( avoidStruts, manageDocks )
+import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,
+                                   ewmhDesktopsLayout )
+
+myXPConfig :: XPConfig
+myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
+                             ,height=22}
+
+
+------------------------------------------------------------------------
+-- Key bindings:
+
+-- | The xmonad key bindings. Add, modify or remove key bindings here.
+--
+-- (The comment formatting character is used when generating the manpage)
+--
+keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
+keys x = M.fromList $
+    -- launching and killing programs
+    [ ((modMask x .|. shiftMask, xK_c     ), kill1) -- %! Close the focused window
+
+    , ((modMask x,               xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms
+    , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %!  Reset the layouts on the current workspace to default
+
+    -- move focus up or down the window stack
+    , ((modMask x,               xK_Tab   ), windows W.focusDown) -- %! Move focus to the next window
+    , ((modMask x,               xK_j     ), windows W.focusDown) -- %! Move focus to the next window
+    , ((modMask x,               xK_k     ), windows W.focusUp  ) -- %! Move focus to the previous window
+
+    , ((modMask x .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window
+    , ((modMask x .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window
+
+    -- floating layer support
+    , ((modMask x,               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling
+
+    -- quit, or restart
+    , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
+    , ((modMask x              , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
+
+    , ((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)
+    , ((modMask x, xK_Down), sendMessage $ Go D)
+    , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R)
+    , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L)
+    , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U)
+    , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D)
+    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
+    , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)
+    , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)
+    , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)
+ 
+    , ((0, xK_F2  ), spawn "gnome-terminal") -- %! Launch gnome-terminal
+    , ((0, xK_F3  ), shellPrompt myXPConfig) -- %! Launch program
+    , ((0, xK_F11   ), spawn "ksnapshot") -- %! Take snapshot
+    , ((modMask x .|. shiftMask, xK_x     ), changeDir myXPConfig)
+    , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)
+    , ((modMask x .|. shiftMask, xK_v     ), selectWorkspace myXPConfig)
+    , ((modMask x, xK_m     ), withWorkspace myXPConfig (windows . W.shift))
+    , ((modMask x .|. shiftMask, xK_m     ), withWorkspace myXPConfig (windows . copy))
+    , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)
+    , ((modMask x, xK_l ), layoutPrompt myXPConfig)
+    , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)
+    , ((modMask x .|. controlMask .|. shiftMask, xK_space),
+       toggleScratchWorkspace (Simplest */* Simplest) )
+
+    ]
+ 
+    ++
+    zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
+    ++
+    zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
+
+config = defaultConfig
+         { borderWidth = 1 -- Width of the window border in pixels.
+         , 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.
+         , XMonad.modMask = mod1Mask
+         , XMonad.keys = keys
+         }
+
+mytab = tabbed CustomShrink defaultTheme
+
+instance Shrinker CustomShrink where
+    shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' 
+    shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' 
+    shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s
+                 where n = length s
+                       halfn = n `div` 2
+                       rs = reverse s
+                       cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs)
+    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
+
+{-
+data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show)
+
+instance UrgencyHook FocusUrgencyHook Window where
+    urgencyHook _ w = modify copyAndFocus
+        where copyAndFocus s
+                  | Just w == W.peek (windowset s) = s
+                  | has w $ W.stack $ W.workspace $ W.current $ windowset s =
+                      s { windowset = until ((Just w ==) . W.peek)
+                                      W.focusUp $ windowset s }
+                  | otherwise =
+                      let t = W.tag $ W.workspace $ W.current $ windowset s
+                      in s { windowset = until ((Just w ==) . W.peek)
+                             W.focusUp $ copyWindow w t $ windowset s }
+              has _ Nothing         = False
+              has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)
+
+-}

XMonad/Config/Sjanssen.hs

@@ -0,0 +1,51 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module XMonad.Config.Sjanssen (sjanssenConfig) where
+
+import XMonad hiding (Tall(..))
+import qualified XMonad.StackSet as W
+import XMonad.Actions.CopyWindow
+import XMonad.Layout.Tabbed
+import XMonad.Layout.HintedTile
+import XMonad.Config (defaultConfig)
+import XMonad.Layout.NoBorders
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageDocks
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+import XMonad.Util.Run (spawnPipe)
+
+import qualified Data.Map as M
+import System.IO (hPutStrLn)
+
+sjanssenConfig = do
+    xmobar <- spawnPipe "xmobar"
+    return $ defaultConfig
+        { terminal = "urxvtc"
+        , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]
+        , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }
+        , modMask = mod4Mask
+        , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
+                [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
+                , ((modm, button2), (\w -> focus w >> windows W.swapMaster))
+                , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
+        , keys = \c -> mykeys c `M.union` keys defaultConfig c
+        , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTheme)
+        , manageHook = manageHook defaultConfig <+> manageDocks
+        }
+ where
+    tiled   = HintedTile 1 0.03 0.5 TopLeft
+
+    mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $
+        [((modm,               xK_p     ), shellPrompt myPromptConfig)
+        ,((modm .|. shiftMask, xK_c     ), kill1)
+        ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)
+        ,((modm .|. shiftMask, xK_0     ), windows $ \w -> foldr copy w ws)
+        ,((modm,               xK_b     ), sendMessage ToggleStruts)
+        ]
+
+    myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
+    myTheme = defaultTheme { fontName = myFont }
+    myPromptConfig = defaultXPConfig
+                        { position = Top
+                        , font = myFont
+                        , promptBorderWidth = 0 }

XMonad/Doc.hs

@@ -0,0 +1,86 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Doc
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- This is the main documentation module for the xmonad-contrib
+-- library. It provides a brief overview of xmonad and a link to
+-- documentation for configuring and extending xmonad.
+--
+-- A link to documentation describing xmonad internals is also provided.
+-- This module is mainly intended for those wanting to contribute code,
+-- or for those who are curious to know what's going on behind the scenes.
+-----------------------------------------------------------------------------
+
+module XMonad.Doc
+    (
+    -- * Overview
+    -- $overview
+
+    -- * Configuring xmonad
+    -- $configuring
+
+    -- * Extending xmonad with the xmonad-contrib library
+    -- $extending
+
+    -- * Developing xmonad: a brief code commentary
+    -- $developing
+
+    ) where
+
+import XMonad.Doc.Configuring ()
+import XMonad.Doc.Extending ()
+import XMonad.Doc.Developing ()
+
+--------------------------------------------------------------------------------
+--
+--  Overview
+--
+--------------------------------------------------------------------------------
+
+{- $overview
+#Overview#
+
+xmonad is a tiling window manager for X. The xmonad-contrib library
+collects third party tiling algorithms, hooks, configurations,
+scripts, and other extensions to xmonad.  The source for this library
+is available from <http://code.haskell.org/XMonadContrib> via darcs:
+
+> darcs get http://code.haskell.org/XMonadContrib
+
+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
+(Mar. 2008) tarball here:
+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.7>
+
+-}
+
+{- $configuring
+
+"XMonad.Doc.Configuring" documents the process of configuring
+xmonad. A brief tutorial will guide you through the basic
+configuration steps.
+
+-}
+
+{- $extending
+
+"XMonad.Doc.Extending" is dedicated to the xmonad-contrib library
+itself. You will find an overview of extensions available in the
+library and instructions for using them.
+
+-}
+
+{- $developing
+
+"XMonad.Doc.Developing" consists of a brief description of the xmonad
+internals.  It is mainly intended for contributors and provides a
+brief code commentary with links to the source documentation.
+
+-}

XMonad/Doc/Configuring.hs

@@ -0,0 +1,153 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Doc.Configuring
+-- Copyright   :  (C) 2007 Don Stewart and Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- This is a brief tutorial that will teach you how to create a
+-- basic xmonad configuration.
+--
+-- For more detailed instructions on extending xmonad with the
+-- xmonad-contrib library, see "XMonad.Doc.Extending".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Doc.Configuring
+    (
+    -- * Configuring xmonad
+    -- $configure
+
+    -- * A simple example
+    -- $example
+
+    -- * Checking whether your xmonad.hs is correct
+    -- $check
+
+    -- * Loading your configuration
+    -- $load
+
+    ) where
+
+--------------------------------------------------------------------------------
+--
+--  Configuring Xmonad
+--
+--------------------------------------------------------------------------------
+
+{- $configure
+#Configuring_xmonad#
+xmonad can be configured by creating and editing the Haskell file:
+
+>    ~/.xmonad/xmonad.hs
+
+If this file does not exist, xmonad will simply use default settings;
+if it does exist, xmonad will use whatever settings you specify.  Note
+that this file can contain arbitrary Haskell code, which means that
+you have quite a lot of flexibility in configuring xmonad.
+
+NOTE for users of previous versions (< 0.5) of xmonad: this is a major
+change in the way xmonad is configured.  Prior to version 0.5,
+configuring xmonad required editing an xmonad source file called
+Config.hs, recompiling xmonad, and then restarting.  From version 0.5
+onwards, however, you should NOT edit this file.  All you have to do
+is edit xmonad.hs and restart with @mod-q@; xmonad does the
+recompiling itself.  The format of the configuration file has also
+changed; it is now simpler and much shorter, only requiring you to
+list those settings which are different from the defaults.
+
+-}
+
+{- $example
+#A_simple_example#
+
+Here is a basic example, which starts with the default xmonad
+configuration and overrides the border width, default terminal, and
+some colours:
+
+>    --
+>    -- An example, simple ~/.xmonad/xmonad.hs file.
+>    -- It overrides a few basic settings, reusing all the other defaults.
+>    --
+>
+>    import XMonad
+>
+>    main = xmonad $ defaultConfig
+>        { borderWidth        = 2
+>        , terminal           = "urxvt"
+>        , normalBorderColor  = "#cccccc"
+>        , focusedBorderColor = "#cd8b00" }
+
+This will run \'xmonad\', the window manager, with your settings
+passed as arguments.
+
+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.
+
+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
+be found in "XMonad.Core".
+
+-}
+
+{- $check
+#Checking_whether_your_xmonad.hs_is_correct#
+
+After changing your configuration, it is a good idea to check that it
+is syntactically and type correct.  You can do this easily by loading
+your configuration file in the Haskell interpreter:
+
+>    $ ghci ~/.xmonad/xmonad.hs
+>    GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help
+>    Loading package base ... linking ... done.
+>    Ok, modules loaded: Main.
+>
+>    Prelude Main> :t main
+>    main :: IO ()
+
+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. (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@. (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
+related to your layouts, you may need to hit @mod-shift-space@ after
+restarting to see the changes take effect.)  If something goes wrong,
+the previous (default) settings will be used.  Note this requires that
+GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can
+still compile @xmonad.hs@ yourself:
+
+>    $ cd ~/.xmonad
+>    $ /path/to/ghc --make xmonad.hs
+>    $ ls
+>    xmonad    xmonad.hi xmonad.hs xmonad.o
+
+When you hit @mod-q@, this newly compiled xmonad will be used.
+
+-}
+

XMonad/Doc/Developing.hs

@@ -0,0 +1,302 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Doc.Developing
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- 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.  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>.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Doc.Developing
+    (
+    -- * Writing new extensions
+    -- $writing
+
+    -- * Libraries for writing window managers
+    -- $xmonad-libs
+
+    -- * xmonad internals
+    -- $internals
+
+    -- ** The @main@ entry point
+    -- $main
+
+    -- ** The X monad and the internal state
+    -- $internalState
+
+    -- ** Event handling and messages
+    -- $events
+
+    -- ** The 'LayoutClass'
+    -- $layoutClass
+
+    -- * Coding style
+    -- $style
+
+    -- * Licensing policy
+    -- $license
+    ) where
+
+--------------------------------------------------------------------------------
+--
+--  Writing Extensions
+--
+--------------------------------------------------------------------------------
+
+{- $writing
+-}
+
+{- $xmonad-libs
+
+Starting with version 0.5, xmonad and xmonad-contrib are packaged and
+distributed as libraries, instead of components which must be compiled
+by the user into a binary (as they were prior to version 0.5). This
+way of distributing xmonad has many advantages, since it allows
+packaging by GNU\/Linux distributions while still allowing the user to
+customize the window manager to fit her needs.
+
+Basically, xmonad and the xmonad-contrib libraries let users write
+their own window manager in just a few lines of code. While
+@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration
+file, it is actually a complete Haskell program which uses the xmonad
+and xmonad-contrib libraries to create a custom window manager.
+
+This makes it possible not only to edit the default xmonad
+configuration, as we have seen in the "XMonad.Doc.Extending" document,
+but to use the Haskell programming language to extend the window
+manager you are writing in any way you see fit.
+
+-}
+
+{- $internals
+-}
+
+{- $main
+#The_main_entry_point#
+
+xmonad installs a binary, @xmonad@, which must be executed by the
+Xsession starting script. This binary, whose code can be read in
+@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile'
+to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@.
+If this compilation process fails, for any reason, a default @main@
+entry point will be used, which calls the 'XMonad.Main.xmonad'
+function with a default configuration.
+
+Thus, the real @main@ entry point, the one that even the users' custom
+window manager application in @~\/.xmonad\/xmonad.hs@ must call, is
+the 'XMonad.Main.xmonad' function. This function takes a configuration
+as its only argument, whose type ('XMonad.Core.XConfig')
+is defined in "XMonad.Core".
+
+'XMonad.Main.xmonad' takes care of opening the connection with the X
+server, initializing the state (or deserializing it when restarted)
+and the configuration, and calling the event handler
+('XMonad.Main.handle') that goes into an infinite loop (using
+'Prelude.forever') waiting for events and acting accordingly.
+
+-}
+
+{- $internalState
+
+The event loop which calls 'XMonad.Main.handle' to react to events is
+run within the 'XMonad.Core.X' monad, which is a
+'Control.Monad.State.StateT' transformer over 'IO', encapsulated
+within a 'Control.Monad.Reader.ReaderT' transformer. The
+'Control.Monad.State.StateT' transformer encapsulates the
+(read\/writable) state of the window manager (of type
+'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT'
+transformer encapsulates the (read-only) configuration (of type
+'XMonad.Core.XConf').
+
+Thanks to GHC's newtype deriving feature, the instance of the
+'Control.Monad.State.MonadState' class parametrized over
+'XMonad.Core.XState' and the instance of the
+'Control.Monad.Reader.MonadReader' class parametrized over
+'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X'
+monad. This way we can use 'Control.Monad.State.get',
+'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the
+'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and
+'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'.
+
+'XMonad.Core.XState' is where all the sensitive information about
+window management is stored. The most important field of the
+'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type
+('XMonad.Core.WindowSet') is a synonym for a
+'XMonad.StackSet.StackSet' parametrized over a
+'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside
+the 'XMonad.Layout.Layout' existential data type, the
+'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the
+'XMonad.Core.ScreenDetail's.
+
+What a 'XMonad.StackSet.StackSet' is and how it can be manipulated
+with pure functions is described in the Haddock documentation of the
+"XMonad.StackSet" module.
+
+The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four
+fields:
+
+* 'XMonad.StackSet.current', for the current, focused workspace. This
+  is a 'XMonad.StackSet.Screen', which is composed of a
+  'XMonad.StackSet.Workspace' together with the screen information (for
+  Xinerama support).
+
+* 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for
+  the other visible (with Xinerama) workspaces.  For non-Xinerama
+  setups, this list is always empty.
+
+* 'XMonad.StackSet.hidden', the list of non-visible
+  'XMonad.StackSet.Workspace's.
+
+* 'XMonad.StackSet.floating', a map from floating
+  'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's
+  specifying their geometry.
+
+The 'XMonad.StackSet.Workspace' type is made of a
+'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and
+a (possibly empty) 'XMonad.StackSet.stack' of windows.
+
+"XMonad.StackSet" (which should usually be imported qualified, to
+avoid name clashes with Prelude functions such as 'Prelude.delete' and
+'Prelude.filter') provides many pure functions to manipulate the
+'XMonad.StackSet.StackSet'. These functions are most commonly used as
+an argument to 'XMonad.Operations.windows', which takes a pure
+function to manipulate the 'XMonad.Core.WindowSet' and does all the
+needed operations to refresh the screen and save the modified
+'XMonad.Core.XState'.
+
+During each 'XMonad.Operations.windows' call, the
+'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and
+'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to
+physically arrange the 'XMonad.StackSet.stack' of windows on each
+workspace.
+
+The possibility of manipulating the 'XMonad.StackSet.StackSet'
+('XMonad.Core.WindowSet') with pure functions makes it possible to
+test all the properties of those functions with QuickCheck, providing
+greater reliability of the core code. Every change to the
+"XMonad.StackSet" module must be accompanied by appropriate QuickCheck
+properties before being applied.
+
+-}
+
+{- $events
+
+Event handling is the core activity of xmonad.  Events generated by
+the X server are most important, but there may also be events
+generated by layouts or the user.
+
+"XMonad.Core" defines a class that generalizes the concept of events,
+'XMonad.Core.Message', constrained to types with a
+'Data.Typeable.Typeable' instance definition (which can be
+automatically derived by ghc). 'XMonad.Core.Message's are wrapped
+within an existential type 'XMonad.Core.SomeMessage'. The
+'Data.Typeable.Typeable' constraint allows for the definition of a
+'XMonad.Core.fromMessage' function that can unwrap the message with
+'Data.Typeable.cast'.  X Events are instances of this class, along
+with any messages used by xmonad itself or by extension modules.
+
+Using the 'Data.Typeable.Typeable' class for any kind of
+'XMonad.Core.Message's and events allows us to define polymorphic functions
+for processing messages or unhandled events.
+
+This is precisely what happens with X events: xmonad passes them to
+'XMonad.Main.handle'. If the main event handling function doesn't have
+anything to do with the event, the event is sent to all visible
+layouts by 'XMonad.Operations.broadcastMessage'.
+
+This messaging system allows the user to create new message types,
+simply declare an instance of the 'Data.Typeable.Typeable' and use
+'XMonad.Operations.sendMessage' to send commands to layouts.
+
+And, finally, layouts may handle X events and other messages within the
+same function... miracles of polymorphism.
+
+-}
+
+{- $layoutClass
+#The_LayoutClass#
+to do
+-}
+
+{- $style
+
+These are the coding guidelines for contributing to xmonad and the
+xmonad contributed extensions.
+
+* Comment every top level function (particularly exported funtions), and
+  provide a type signature.
+
+* Use Haddock syntax in the comments (see below).
+
+* Follow the coding style of the other modules.
+
+* Code should be compilable with -Wall -Werror. There should be no warnings.
+
+* Partial functions should be avoided: the window manager should not
+  crash, so do not call 'error' or 'undefined'.
+
+* Tabs are /illegal/. Use 4 spaces for indenting.
+
+* Any pure function added to the core should have QuickCheck properties
+  precisely defining its behaviour.
+
+For examples of Haddock documentation syntax, have a look at other
+extensions.  Important points are:
+
+* Every exported function (or even better, every function) should have
+  a Haddock comment explaining what it does.
+
+* Literal chunks of code can be written in comments using
+  \"birdtrack\" notation (a greater-than symbol at the beginning of
+  each line).  Be sure to leave a blank line before and after each
+  birdtrack-quoted section.
+
+* Link to functions by surrounding the names in single quotes, modules
+  in double quotes.
+
+* Literal quote marks and slashes should be escaped with a backslash.
+
+To generate and view the Haddock documentation for your extension, run
+
+> runhaskell Setup haddock
+
+and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.
+
+For more information, see the Haddock documentation:
+<http://www.haskell.org/haddock/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
+
+New modules should identify the author, and be submitted under the
+same license as xmonad (BSD3 license or freer).
+
+-}

XMonad/Doc/Extending.hs

@@ -0,0 +1,981 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Doc.Extending
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- This module documents the xmonad-contrib library and
+-- how to use it to extend the capabilities of xmonad.
+--
+-- Reading this document should not require a deep knowledge of
+-- Haskell; the examples are intended to be useful and understandable
+-- for those users who do not know Haskell and don't want to have to
+-- learn it just to configure xmonad.  You should be able to get by
+-- just fine by ignoring anything you don't understand and using the
+-- provided examples as templates.  However, relevant Haskell features
+-- are discussed when appropriate, so this document will hopefully be
+-- useful for more advanced Haskell users as well.
+--
+-- Those wishing to be totally hardcore and develop their own xmonad
+-- extensions (it's easier than it sounds, we promise!) should read
+-- the documentation in "XMonad.Doc.Developing".
+--
+-- More configuration examples may be found on the Haskell wiki:
+--
+-- <http://haskell.org/haskellwiki/Xmonad/Config_archive>
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Doc.Extending
+    (
+    -- * The xmonad-contrib library
+    -- $library
+
+    -- ** Actions
+    -- $actions
+
+    -- ** Configurations
+    -- $configs
+
+    -- ** Hooks
+    -- $hooks
+
+    -- ** Layouts
+    -- $layouts
+
+    -- ** Prompts
+    -- $prompts
+
+    -- ** Utilities
+    -- $utils
+
+    -- * Extending xmonad
+    -- $extending
+
+    -- ** Editing key bindings
+    -- $keys
+
+    -- *** Adding key bindings
+    -- $keyAdding
+
+    -- *** Removing key bindings
+    -- $keyDel
+
+    -- *** Adding and removing key bindings
+    -- $keyAddDel
+
+    -- ** Editing mouse bindings
+    -- $mouse
+
+    -- ** Editing the layout hook
+    -- $layoutHook
+
+    -- ** Editing the manage hook
+    -- $manageHook
+
+    -- ** The log hook and external status bars
+    -- $logHook
+    ) where
+
+--------------------------------------------------------------------------------
+--
+--  The XmonadContrib Library
+--
+--------------------------------------------------------------------------------
+
+{- $library
+
+The xmonad-contrib (xmc) library is a set of extension modules
+contributed by xmonad hackers and users, which provide additional
+xmonad features.  Examples include various layout modes (tabbed,
+spiral, three-column...), prompts, program launchers, the ability to
+manipulate windows and workspaces in various ways, alternate
+navigation modes, and much more.  There are also \"meta-modules\"
+which make it easier to write new modules and extensions.
+
+This is a concise yet complete overview of the xmonad-contrib modules.
+For more information about any particular module, just click on its
+name to view its Haddock documentation; each module should come with
+extensive documentation.  If you find a module that could be better
+documented, or has incorrect documentation, please report it as a bug
+(<http://code.google.com/p/xmonad/issues/list>)!
+
+-}
+
+{- $actions
+
+In the @XMonad.Actions@ namespace you can find modules exporting
+various functions that are usually intended to be bound to key
+combinations or mouse actions, in order to provide functionality
+beyond the standard keybindings provided by xmonad.
+
+See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to
+edit your key bindings.
+
+* "XMonad.Actions.Commands": running internal xmonad actions
+  interactively.
+
+* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained
+  window resizing mode.
+
+* "XMonad.Actions.CopyWindow": duplicating windows on multiple
+  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, delete, and rename workspaces.
+
+* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace.
+
+* "XMonad.Actions.FlexibleManipulate": move\/resize windows without
+  warping the mouse.
+
+* "XMonad.Actions.FlexibleResize": resize windows from any corner.
+
+* "XMonad.Actions.FloatKeys": move\/resize floating windows with
+  keybindings.
+
+* "XMonad.Actions.FocusNth": focus the nth window on the screen.
+
+* "XMonad.Actions.MouseGestures": bind mouse gestures to actions.
+
+* "XMonad.Actions.MouseResize": use with
+  "XMonad.Layout.WindowArranger" to resize windows with the mouse when
+  using a floating layout.
+
+* "XMonad.Actions.NoBorders": forcibly remove borders from a window.
+  Not to be confused with "XMonad.Layout.NoBorders".
+
+* "XMonad.Actions.PerWorkspaceKeys": configure keybindings
+  per-workspace.
+
+* "XMonad.Actions.Promote": An action to move the focused window to
+  the master pane, or swap the master with the next window.
+
+* "XMonad.Actions.RotSlaves": rotate non-master windows.
+
+* "XMonad.Actions.Search": provide helpful functions for easily
+  running web searchs.
+
+* "XMonad.Actions.SimpleDate": display the date in a popup menu.
+
+* "XMonad.Actions.SinkAll": sink all floating windows.
+
+* "XMonad.Actions.Submap": create key submaps, i.e. the ability to
+  bind actions to key sequences rather than being limited to single
+  key combinations.
+
+* "XMonad.Actions.SwapWorkspaces": swap workspace tags.
+
+* "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.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.
+
+-}
+
+{- $configs
+
+In the @XMonad.Config@ namespace you can find modules exporting the
+configurations used by some of the xmonad and xmonad-contrib
+developers.  You can look at them for examples while creating your own
+configuration; you can also simply import them and use them as your
+own configuration, possibly with some modifications.
+
+* "XMonad.Config.Arossato"
+
+* "XMonad.Config.Dons"
+
+* "XMonad.Config.Droundy"
+
+* "XMonad.Config.Sjanssen"
+
+-}
+
+{- $hooks
+
+In the @XMonad.Hooks@ namespace you can find modules exporting
+hooks. Hooks are actions that xmonad performs when certain events
+occur. The two most important hooks are:
+
+* 'XMonad.Core.manageHook': this hook is called when a new window
+  xmonad must take care of is created. This is a very powerful hook,
+  since it lets us examine the new window's properties and act
+  accordingly. For instance, we can configure xmonad to put windows
+  belonging to a given application in the float layer, not to manage
+  dock applications, or open them in a given workspace. See
+  "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on
+  customizing 'XMonad.Core.manageHook'.
+
+* 'XMonad.Core.logHook': this hook is called when the stack of windows
+  managed by xmonad has been changed, by calling the
+  'XMonad.Operations.windows' function. For instance
+  "XMonad.Hooks.DynamicLog" will produce a string (whose format can be
+  configured) to be printed to the standard output. This can be used
+  to display some information about the xmonad state in a status bar.
+  See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more
+  information.
+
+Here is a list of the modules found in @XMonad.Hooks@:
+
+* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send
+  information about xmonad's state to standard output, suitable for
+  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 (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.
+
+* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window
+  sets the urgent flag.
+
+* "XMonad.Hooks.XPropManage": match on XProperties in your
+  'XMonad.Core.manageHook'.
+
+-}
+
+{- $layouts
+
+In the @XMonad.Layout@ namespace you can find modules exporting
+contributed tiling algorithms, such as a tabbed layout, a circle, a spiral,
+three columns, and so on.
+
+You will also find modules which provide facilities for combining
+different layouts, such as "XMonad.Layout.Combo", or
+"XMonad.Layout.LayoutCombinators".
+
+Layouts can be also modified with layout modifiers. A general
+interface for writing layout modifiers is implemented in
+"XMonad.Layout.LayoutModifier".
+
+For more information on using those modules for customizing your
+'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook".
+
+* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the
+  top and bottom of the screen.
+
+* "XMonad.Layout.Circle": an elliptical, overlapping layout.
+
+* "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.
+
+* "XMonad.Layout.LayoutModifier": a general framework for creating
+  layout \"modifiers\"; useful for creating new layout modules.
+
+* "XMonad.Layout.LayoutScreens": divide the screen into multiple
+  virtual \"screens\".
+
+* "XMonad.Layout.MagicFocus": automagically put the focused window in
+  the master area.
+
+* "XMonad.Layout.Magnifier": increase the size of the focused window
+
+* "XMonad.Layout.Maximize": temporarily maximize the focused window.
+
+* "XMonad.Layout.MosaicAlt": give each window a specified relative
+  amount of screen space.
+
+* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout
+  transformers.
+
+* "XMonad.Layout.Named": change the names of layouts (as reported by
+  e.g. "XMonad.Hooks.DynamicLog").
+
+* "XMonad.Layout.NoBorders": display windows without borders.
+
+* "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.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.
+
+* "XMonad.Layout.WorkspaceDir": set the current working directory in a
+  workspace.
+
+-}
+
+{- $prompts
+
+In the @XMonad.Prompt@ name space you can find modules providing
+graphical prompts for getting user input and using it to perform
+various actions.
+
+The "XMonad.Prompt" provides a library for easily writing new prompt
+modules.
+
+These are the available prompts:
+
+* "XMonad.Prompt.AppendFile": append lines of text to a file.
+
+* "XMonad.Prompt.Directory": prompt for a directory.
+
+* "XMonad.Prompt.DirExec": put a bunch of scripts you want in a
+  directory, then choose from among them with this prompt.
+
+* "XMonad.Prompt.Email": an example of "XMonad.Prompt.Input", send
+  simple short e-mails from a prompt.
+
+* "XMonad.Prompt.Input": useful for building general actions requiring
+  input from a prompt.
+
+* "XMonad.Prompt.Layout": choose a layout from a prompt.
+
+* "XMonad.Prompt.Man": open man pages.
+
+* "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
+of adding some prompts.
+
+-}
+
+{- $utils
+
+In the @XMonad.Util@ namespace you can find modules exporting various
+utility functions that are used by the other modules of the
+xmonad-contrib library.
+
+There are also utilities for helping in configuring xmonad or using
+external utilities.
+
+A non complete list with a brief description:
+
+* "XMonad.Util.CustomKeys": 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;
+
+* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for
+  accessing Xlib and XFT function in a convenient way.
+
+-}
+
+--------------------------------------------------------------------------------
+--
+--  Extending Xmonad
+--
+--------------------------------------------------------------------------------
+
+{- $extending
+#Extending_xmonad#
+
+Since the @xmonad.hs@ file is just another Haskell module, you may
+import and use any Haskell code or libraries you wish, such as
+extensions from the xmonad-contrib library, or other code you write
+yourself.
+
+-}
+
+{- $keys
+#Editing_key_bindings#
+
+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:
+
+>    myKeys x =
+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)
+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)
+>             ]
+
+This particular definition also requires importing "XMonad.Prompt",
+"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":
+
+> 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.
+
+-}
+
+{- $keyAdding
+#Adding_key_bindings#
+
+Adding key bindings can be done in different ways. The type signature
+of 'XMonad.Core.XConfig.keys' is:
+
+>    keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())
+
+In order to add new key bindings, you need to first create an
+appropriate 'Data.Map.Map' from a list of key bindings using
+'Data.Map.fromList'.  This 'Data.Map.Map' of new key bindings then
+needs to be joined to a 'Data.Map.Map' of existing bindings using
+'Data.Map.union'.
+
+Since we are going to need some of the functions of the "Data.Map"
+module, before starting we must first import this modules:
+
+>    import qualified Data.Map as M
+
+
+For instance, if you have defined some additional key bindings like
+these:
+
+>    myKeys x =
+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)
+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)
+>             ]
+
+then you can create a new key bindings map by joining the default one
+with yours:
+
+>    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))
+
+Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field
+of the configuration:
+
+>    main = xmonad $ defaultConfig { keys = newKeys }
+
+All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
+
+
+>    module Main (main) where
+>
+>    import XMonad
+>
+>    import qualified Data.Map as M
+>    import Graphics.X11.Xlib
+>    import XMonad.Prompt
+>    import XMonad.Prompt.Shell
+>    import XMonad.Prompt.XMonad
+>
+>    main :: IO ()
+>    main = xmonad $ defaultConfig { keys = newKeys }
+>
+>    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))
+>
+>    myKeys x =
+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)
+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)
+>             ]
+
+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>\".
+
+ -}
+
+{- $keyDel
+#Removing_key_bindings#
+
+Removing key bindings requires modifying the 'Data.Map.Map' which
+stores the key bindings.  This can be done with 'Data.Map.difference'
+or with 'Data.Map.delete'.
+
+For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
+(you just want to leave xmonad running forever). To do this you need
+to define @newKeys@ as a 'Data.Map.difference' between the default
+map and the map of the key bindings you want to remove.  Like so:
+
+>    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)
+>
+>    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]
+>    keysToRemove x =
+>             [ ((modMask x              , xK_q ), return ())
+>             , ((modMask x .|. shiftMask, xK_q ), return ())
+>             ]
+
+As you can see, it doesn't matter what actions we associate with the
+keys listed in @keysToRemove@, so we just use @return ()@ (the
+\"null\" action).
+
+It is also possible to simply define a list of keys we want to unbind
+and then use 'Data.Map.delete' to remove them. In that case we would
+write something like:
+
+>    newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)
+>
+>    keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]
+>    keysToRemove x =
+>             [ (modMask x              , xK_q )
+>             , (modMask x .|. shiftMask, xK_q )
+>             ]
+
+Another even simpler possibility is the use of some of the utilities
+provided by the xmonad-contrib library. Look, for instance, at
+'XMonad.Util.EZConfig.removeKeys'.
+
+-}
+
+{- $keyAddDel
+#Adding_and_removing_key_bindings#
+
+Adding and removing key bindings requires simply combining the steps
+for removing and adding.  Here is an example from
+"XMonad.Config.Arossato":
+
+>    defKeys    = keys defaultConfig
+>    delKeys x  = foldr M.delete           (defKeys x) (toRemove x)
+>    newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)
+>    -- remove some of the default key bindings
+>    toRemove x =
+>        [ (modMask x              , xK_j     )
+>        , (modMask x              , xK_k     )
+>        , (modMask x              , xK_p     )
+>        , (modMask x .|. shiftMask, xK_p     )
+>        , (modMask x .|. shiftMask, xK_q     )
+>        , (modMask x              , xK_q     )
+>        ] ++
+>        -- I want modMask .|. shiftMask 1-9 to be free!
+>        [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]
+>    -- These are my personal key bindings
+>    toAdd x   =
+>        [ ((modMask x              , xK_F12   ), xmonadPrompt defaultXPConfig )
+>        , ((modMask x              , xK_F3    ), shellPrompt  defaultXPConfig )
+>        ] ++
+>        -- Use modMask .|. shiftMask .|. controlMask 1-9 instead
+>        [( (m .|. modMask x, k), windows $ f i)
+>         | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]
+>        ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]
+>        ]
+
+You can achieve the same result using the "XMonad.Util.CustomKeys"
+module; take a look at the 'XMonad.Util.CustomKeys.customKeys'
+function in particular.
+
+-}
+
+{- $mouse
+#Editing_mouse_bindings#
+
+Most of the previous discussion of key bindings applies to mouse
+bindings as well.  For example, you could configure button4 to close
+the window you click on like so:
+
+>    import qualified Data.Map as M
+>
+>    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]
+>
+>    newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))
+>
+>    main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }
+
+Overriding or deleting mouse bindings works similarly.  You can also
+configure mouse bindings much more easily using the
+'XMonad.Util.EZConfig.additionalMouseBindings' and
+'XMonad.Util.EZConfig.removeMouseBindings' functions from the
+"XMonad.Util.EZConfig" module.
+
+-}
+
+{- $layoutHook
+#Editing_the_layout_hook#
+
+When you start an application that opens a new window, when you change
+the focused window, or move it to another workspace, or change that
+workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for
+reordering the visible windows on the visible workspace(s).
+
+Since different layouts may be attached to different workspaces, and
+you can change them, xmonad needs to know which one to use. In this
+sense the layoutHook may be thought as the list of layouts that
+xmonad will use for laying out windows on the screen(s).
+
+The problem is that the layout subsystem is implemented with an
+advanced feature of the Haskell programming language: type classes.
+This allows us to very easily write new layouts, combine or modify
+existing layouts, create layouts with internal state, etc. See
+"XMonad.Doc.Extending#The_LayoutClass" for more information. This
+means that we cannot simply have a list of layouts as we used to have
+before the 0.5 release: a list requires every member to belong to the
+same type!
+
+Instead the combination of layouts to be used by xmonad is created
+with a specific layout combinator: 'XMonad.Layout.|||'.
+
+Suppose we want a list with the 'XMonad.Layout.Full',
+'XMonad.Layout.Tabbed.tabbed' and
+'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our
+@~\/.xmonad\/xmonad.hs@, all the needed modules:
+
+>    import XMonad
+>
+>    import XMonad.Layout.Tabbed
+>    import XMonad.Layout.Accordion
+
+Then we create the combination of layouts we need:
+
+>    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion
+
+
+Now, all we need to do is change the 'XMonad.Core.layoutHook'
+field of the 'XMonad.Core.XConfig' record, like so:
+
+>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
+
+Thanks to the new combinator, we can apply a layout modifier to a
+whole combination of layouts, instead of applying it to each one. For
+example, suppose we want to use the
+'XMonad.Layout.NoBorders.noBorders' layout modifier, from the
+"XMonad.Layout.NoBorders" module (which must be imported):
+
+>    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)
+
+If we want only the tabbed layout without borders, then we may write:
+
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+
+Our @~\/.xmonad\/xmonad.hs@ will now look like this:
+
+>    import XMonad
+>
+>    import XMonad.Layout.Tabbed
+>    import XMonad.Layout.Accordion
+>    import XMonad.Layout.NoBorders
+>
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+>
+>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
+
+That's it!
+
+-}
+
+{- $manageHook
+#Editing_the_manage_hook#
+
+The 'XMonad.Core.manageHook' is a very powerful tool for customizing
+the behavior of xmonad with regard to new windows.  Whenever a new
+window is created, xmonad calls the 'XMonad.Core.manageHook', which
+can thus be used to perform certain actions on the new window, such as
+placing it in a specific workspace, ignoring it, or placing it in the
+float layer.
+
+The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer
+and Gimp, and to ignore gnome-panel, desktop_window, kicker, and
+kdesktop.
+
+The "XMonad.ManageHook" module provides some simple combinators that
+can be used to alter the 'XMonad.Core.manageHook' by replacing or adding
+to the default actions.
+
+Let's start by analyzing the default 'XMonad.Config.manageHook', defined
+in "XMonad.Config":
+
+
+>    manageHook :: ManageHook
+>    manageHook = composeAll
+>                    [ className =? "MPlayer"        --> doFloat
+>                    , className =? "Gimp"           --> doFloat
+>                    , resource  =? "desktop_window" --> doIgnore
+>                    , resource  =? "kdesktop"       --> doIgnore ]
+
+'XMonad.ManageHook.composeAll' can be used to compose a list of
+different 'XMonad.Config.ManageHook's. In this example we have a list
+of 'XMonad.Config.ManageHook's formed by the following commands: the
+Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className'
+are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the
+float layer with the 'XMonad.ManageHook.doFloat' function; the windows
+whose resource names are respectively \"desktop_window\" and
+\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore'
+function.
+
+This is another example of 'XMonad.Config.manageHook', taken from
+"XMonad.Config.Arossato":
+
+>    myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat
+>                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf
+>                               , resource =? "firefox-bin"  --> doF (W.shift "web")
+>                               ]
+>    newManageHook = myManageHook <+> manageHook defaultConfig
+
+
+Again we use 'XMonad.ManageHook.composeAll' to compose a list of
+different 'XMonad.Config.ManageHook's. The first one will put
+RealPlayer on the float layer, the second one will put the xpdf
+windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF'
+and 'XMonad.StackSet.shift' functions, and the third one will put all
+firefox windows on the workspace called "web". Then we use the
+'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the
+default 'XMonad.Config.manageHook' to form @newManageHook@.
+
+Each 'XMonad.Config.ManageHook' has the form:
+
+>    property =? match --> action
+
+Where @property@ can be:
+
+* 'XMonad.ManageHook.title': the window's title
+
+* 'XMonad.ManageHook.resource': the resource name
+
+* '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
+
+> xprop | grep WM_CLASS
+
+at a prompt, then click on the window whose resource class you want to
+know.)
+
+@match@ is the string that will match the property value (for instance
+the one you retrieved with @xprop@).
+
+An  @action@ can be:
+
+* 'XMonad.ManageHook.doFloat': to place the window in the float layer;
+
+* 'XMonad.ManageHook.doIgnore': to ignore the window;
+
+* 'XMonad.ManageHook.doF': to execute a function with the window as
+  argument.
+
+For example, suppose we want to add a 'XMonad.Config.manageHook' to
+float RealPlayer, which usually has a 'XMonad.ManageHook.resource'
+name of \"realplay.bin\".
+
+First we need to import "XMonad.ManageHook":
+
+>    import XMonad.ManageHook
+
+Then we create our own 'XMonad.Config.manageHook':
+
+>    myManageHook = resource =? "realplay.bin" --> doFloat
+
+We can now use the 'XMonad.ManageHook.<+>' combinator to add our
+'XMonad.Config.manageHook' to the default one:
+
+>    newManageHook = myManageHook <+> manageHook defaultConfig
+
+(Of course, if we wanted to completely replace the default
+'XMonad.Config.manageHook', this step would not be necessary.) Now,
+all we need to do is change the 'XMonad.Core.manageHook' field of the
+'XMonad.Core.XConfig' record, like so:
+
+>    main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }
+
+And we are done.
+
+Obviously, we may wish to add more then one
+'XMonad.Config.manageHook'. In this case we can use a list of hooks,
+compose them all with 'XMonad.ManageHook.composeAll', and add the
+composed to the default one.
+
+For instance, if we want RealPlayer to float and thunderbird always
+opened in the workspace named "mail", we can do so like this:
+
+>    myManageHook = composeAll [ resource =? "realplay.bin"    --> doFloat
+>                              , resource =? "thunderbird-bin" --> doF (W.shift "mail")
+>                              ]
+
+Remember to import the module that defines the 'XMonad.StackSet.shift'
+function, "XMonad.StackSet", like this:
+
+>    import qualified XMonad.StackSet as W
+
+And then we can add @myManageHook@ to the default one to create
+@newManageHook@ as we did in the previous example.
+
+One more thing to note about this system is that if
+a window matches multiple rules in a 'XMonad.Config.manageHook', /all/
+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
+#The_log_hook_and_external_status_bars#
+
+When the stack of the windows managed by xmonad changes for any
+reason, xmonad will call 'XMonad.Core.logHook', which can be used to
+output some information about the internal state of xmonad, such as the
+layout that is presently in use, the workspace we are in, the focused
+window's title, and so on.
+
+Extracting information about the internal xmonad state can be somewhat
+difficult if you are not familiar with the source code. Therefore,
+it's usually easiest to use a module that has been designed
+specifically for logging some of the most interesting information
+about the internal state of xmonad: "XMonad.Hooks.DynamicLog".  This
+module can be used with an external status bar to print the produced
+logs in a convenient way; the most commonly used status bars are dzen
+and xmobar.
+
+By default the 'XMonad.Core.logHook' doesn't produce anything. To
+enable it you need first to import "XMonad.Hooks.DynamicLog":
+
+>    import XMonad.Hooks.DynamicLog
+
+Then you just need to update the 'XMonad.Core.logHook' field of the
+'XMonad.Core.XConfig' record with one of the provided functions. For
+example:
+
+>    main = xmonad defaultConfig { logHook = dynamicLog }
+
+More interesting configurations are also possible; see the
+"XMonad.Hooks.DynamicLog" module for more possibilities.
+
+You may now enjoy your extended xmonad experience.
+
+Have fun!
+
+-}

XMonad/Hooks/DynamicLog.hs

@@ -0,0 +1,424 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DynamicLog
+-- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- 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,
+    dynamicLogXinerama,
+
+    -- * Build your own formatter
+    dynamicLogWithPP,
+    dynamicLogString,
+    PP(..), defaultPP, dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
+
+    -- * Formatting utilities
+    wrap, pad, shorten,
+    xmobarColor, dzenColor, dzenEscape,
+
+    -- * Internal formatting functions
+    pprWindowSet,
+    pprWindowSetXinerama
+
+    -- * To Do
+    -- $todo
+
+  ) where
+
+--
+-- Useful imports
+--
+import XMonad
+import Data.Maybe ( isJust, catMaybes )
+import Data.List
+import Data.Ord ( comparing )
+import qualified XMonad.StackSet as S
+import System.IO
+import XMonad.Util.WorkspaceCompare
+import XMonad.Util.NamedWindows
+import XMonad.Util.Run
+import XMonad.Hooks.UrgencyHook
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad
+-- >    import XMonad.Hooks.DynamicLog
+--
+-- 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.  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
+  h <- spawnPipe ("dzen2" ++ " " ++ flags)
+  f $ defaultConfig
+           { defaultGaps = [(15,0,0,0)] -- for fixed
+           , logHook = dynamicLogWithPP dzenPP
+                          { ppOutput = hPutStrLn h } }
+ where
+    fg      = "'#a8a3f7'" -- n.b quoting
+    bg      = "'#3f3c6d'"
+    flags   = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg
+
+-- | 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
+
+-- | 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 = dynamicLogString pp >>= io . ppOutput pp
+
+-- | The same as 'dynamicLogWithPP', except it simply returns the status
+--   as a formatted string without actually printing it to stdout, to
+--   allow for further processing, or use in some application other than
+--   a status bar.
+dynamicLogString :: PP -> X String
+dynamicLogString pp = do
+
+    winset <- gets windowset
+    urgents <- readUrgents
+    sort' <- ppSort pp
+
+    -- layout description
+    let ld = description . S.layout . S.workspace . S.current $ winset
+
+    -- workspace list
+    let ws = pprWindowSet sort' urgents pp winset
+
+    -- window title
+    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
+
+    -- run extra loggers, ignoring any that generate errors.
+    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
+
+    return $ sepBy (ppSep pp) . ppOrder pp $
+                        [ ws
+                        , ppLayout pp ld
+                        , ppTitle  pp wt
+                        ]
+                        ++ catMaybes extras
+
+-- | Format the workspace information, given a workspace sorting function,
+--   a list of urgent windows, a pretty-printer format, and the current
+--   WindowSet.
+pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String
+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
+            map S.workspace (S.current s : S.visible s) ++ S.hidden s
+   where this     = S.tag (S.workspace (S.current s))
+         visibles = map (S.tag . S.workspace) (S.visible s)
+
+         fmt w = printer pp (S.tag w)
+          where printer | S.tag w == this                                               = ppCurrent
+                        | S.tag w `elem` visibles                                       = ppVisible
+                        | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = \ppC -> ppUrgent ppC . ppHidden ppC
+                        | isJust (S.stack w)                                            = ppHidden
+                        | otherwise                                                     = ppHiddenNoWindows
+
+-- |
+-- Workspace logger with a format designed for Xinerama:
+--
+-- > [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.
+--
+-- 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
+
+pprWindowSetXinerama :: WindowSet -> String
+pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
+  where onscreen  = map (S.tag . S.workspace)
+                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws
+        offscreen = map S.tag . filter (isJust . S.stack)
+                        . sortBy (comparing S.tag) $ S.hidden ws
+
+-- | 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 = "..."
+
+-- | 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)
+
+-- | 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()")
+       (bg1,bg2) | null bg = ("","")
+                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")
+
+-- | Escape any dzen metacharacters.
+dzenEscape :: String -> String
+dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])
+
+-- | Use xmobar escape codes to output a string with given foreground
+--   and background colors.
+xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
+            -> String  -- ^ background color
+            -> String  -- ^ output string
+            -> String
+xmobarColor fg bg = wrap t "</fc>"
+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
+
+-- ??? add an xmobarEscape function?
+
+-- | The 'PP' type allows the user to customize the formatting of
+--   status information.
+data PP = PP { ppCurrent :: WorkspaceId -> String
+               -- ^ how to print the tag of the currently focused
+               -- workspace
+             , ppVisible :: WorkspaceId -> String
+               -- ^ how to print tags of visible but not focused
+               -- workspaces (xinerama only)
+             , ppHidden  :: WorkspaceId -> String
+               -- ^ how to print tags of hidden workspaces which
+               -- contain windows
+             , ppHiddenNoWindows :: WorkspaceId -> String
+               -- ^ how to print tags of empty hidden workspaces
+             , ppUrgent :: WorkspaceId -> String
+               -- ^ format to be applied to tags of urgent workspaces.
+               -- NOTE that 'ppUrgent' is applied /in addition to/
+               -- 'ppHidden'!
+             , ppSep :: String
+               -- ^ separator to use between different log sections
+               -- (window name, layout, workspaces)
+             , ppWsSep :: String
+               -- ^ separator to use between workspace tags
+             , ppTitle :: String -> String
+               -- ^ window title format
+             , ppLayout :: String -> String
+               -- ^ layout name format
+             , ppOrder :: [String] -> [String]
+               -- ^ how to order the different log sections. By
+               --   default, this function receives a list with three
+               --   formatted strings, representing the workspaces,
+               --   the layout, and the current window title,
+               --   respectively. If you have specified any extra
+               --   loggers in 'ppExtras', their output will also be
+               --   appended to the list.  To get them in the reverse
+               --   order, you can just use @ppOrder = reverse@.  If
+               --   you don't want to display the current layout, you
+               --   could use something like @ppOrder = \\(ws:_:t:_) ->
+               --   [ws,t]@, and so on.
+             , ppSort :: X ([WindowSpace] -> [WindowSpace])
+               -- ^ how to sort the workspaces.  See
+               -- "XMonad.Util.WorkspaceCompare" for some useful
+               -- sorts.
+             , ppExtras :: [X (Maybe String)]
+               -- ^ loggers for generating extra information such as
+               -- time and date, system load, battery status, and so
+               -- on.  See "XMonad.Util.Loggers" for examples, or create
+               -- your own!
+             , ppOutput :: String -> IO ()
+               -- ^ applied to the entire formatted string in order to
+               -- output it.  Can be used to specify an alternative
+               -- output method (e.g. write to a pipe instead of
+               -- stdout), and\/or to perform some last-minute
+               -- formatting.
+             }
+
+-- | The default pretty printing options, as seen in 'dynamicLog'.
+defaultPP :: PP
+defaultPP = PP { ppCurrent         = wrap "[" "]"
+               , ppVisible         = wrap "<" ">"
+               , ppHidden          = id
+               , ppHiddenNoWindows = const ""
+               , ppUrgent          = id
+               , ppSep             = " : "
+               , ppWsSep           = " "
+               , ppTitle           = shorten 80
+               , ppLayout          = id
+               , ppOrder           = id
+               , ppOutput          = putStrLn
+               , ppSort            = getSortByIndex
+               , ppExtras          = []
+               }
+
+-- | Settings to emulate dwm's statusbar, dzen only.
+dzenPP :: PP
+dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
+                     , ppVisible  = dzenColor "black" "#999999" . pad
+                     , ppHidden   = dzenColor "black" "#cccccc" . pad
+                     , ppHiddenNoWindows = const ""
+                     , ppUrgent   = dzenColor "red" "yellow"
+                     , ppWsSep    = ""
+                     , ppSep      = ""
+                     , ppLayout   = dzenColor "black" "#cccccc" .
+                                    (\ x -> case x of
+                                              "TilePrime Horizontal" -> " TTT "
+                                              "TilePrime Vertical"   -> " []= "
+                                              "Hinted Full"          -> " [ ] "
+                                              _                      -> pad x
+                                    )
+                     , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
+                     }
+
+-- | 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
+                       }
+
+-- | 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

@@ -0,0 +1,206 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.EwmhDesktops
+-- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>
+-- License      : BSD
+--
+-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Makes xmonad use the EWMH hints to tell panel applications about its
+-- 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,
+    ewmhDesktopsLayout
+    ) where
+
+import Data.List
+import Data.Maybe
+
+import XMonad
+import Control.Monad
+import qualified XMonad.StackSet as W
+
+import XMonad.Hooks.SetWMName
+import XMonad.Util.WorkspaceCompare
+import XMonad.Hooks.EventHook
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Hooks.EwmhDesktops
+-- >
+-- > myLogHook :: X ()
+-- > myLogHook = do ewmhDesktopsLogHook
+-- >                return ()
+-- >
+-- > 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' <- getSortByIndex
+    let ws = sort' $ W.workspaces s
+    let wins = W.allWindows s
+
+    setSupported
+
+    -- Number of Workspaces
+    setNumberOfDesktops (length ws)
+
+    -- Names thereof
+    setDesktopNames (map W.tag ws)
+
+    -- Current desktop
+    let curr = fromJust $ elemIndex (W.tag (W.workspace (W.current s))) $ map W.tag ws
+
+    setCurrentDesktop curr
+
+    setClientList wins
+
+    -- 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.integrate' (W.stack (W.workspace x))) $ \win -> do
+            setWindowDesktop win curr
+
+    forM_ (W.hidden s) $ \w ->
+        let wn = fromJust $ elemIndex (W.tag w) (map W.tag ws) in
+        forM_ (W.integrate' (W.stack w)) $ \win -> do
+            setWindowDesktop win wn
+
+    setActiveWindow
+
+    return ()
+
+-- |
+-- Intercepts messages from pagers and similar applications and reacts on them.
+-- Currently supports:
+--
+--  * _NET_CURRENT_DESKTOP (switching desktops)
+--
+--  * _NET_WM_DESKTOP (move windows to other desktops)
+--
+--  * _NET_ACTIVE_WINDOW (activate another window)
+--
+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
+    a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
+    c <- getAtom "CARDINAL"
+    r <- asks theRoot
+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]
+
+setCurrentDesktop :: (Integral a) => a -> X ()
+setCurrentDesktop i = withDisplay $ \dpy -> do
+    a <- getAtom "_NET_CURRENT_DESKTOP"
+    c <- getAtom "CARDINAL"
+    r <- asks theRoot
+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]
+
+setDesktopNames :: [String] -> X ()
+setDesktopNames names = withDisplay $ \dpy -> do
+    -- Names thereof
+    r <- asks theRoot
+    a <- getAtom "_NET_DESKTOP_NAMES"
+    c <- getAtom "UTF8_STRING"
+    let names' = map (fromIntegral.fromEnum) $
+            concatMap (++['\0']) names
+    io $ changeProperty8 dpy r a c propModeReplace names'
+
+setClientList :: [Window] -> X ()
+setClientList wins = withDisplay $ \dpy -> do
+    -- (What order do we really need? Something about age and stacking)
+    r <- asks theRoot
+    c <- getAtom "WINDOW"
+    a <- getAtom "_NET_CLIENT_LIST"
+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)
+    a' <- getAtom "_NET_CLIENT_LIST_STACKING"
+    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
+
+setWindowDesktop :: (Integral a) => Window -> a -> X ()
+setWindowDesktop win i = withDisplay $ \dpy -> do
+    a <- getAtom "_NET_WM_DESKTOP"
+    c <- getAtom "CARDINAL"
+    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]
+
+setSupported :: X ()
+setSupported = withDisplay $ \dpy -> do
+    r <- asks theRoot
+    a <- getAtom "_NET_SUPPORTED"
+    c <- getAtom "ATOM"
+    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
+                         ,"_NET_NUMBER_OF_DESKTOPS"
+                         ,"_NET_CLIENT_LIST"
+                         ,"_NET_CLIENT_LIST_STACKING"
+                         ,"_NET_CURRENT_DESKTOP"
+                         ,"_NET_DESKTOP_NAMES"
+                         ,"_NET_ACTIVE_WINDOW"
+                         ,"_NET_WM_DESKTOP"
+                         ,"_NET_WM_STRUT"
+                         ]
+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
+
+    setWMName "xmonad"
+
+setActiveWindow :: X ()
+setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
+    let w = fromMaybe 0 (W.peek s)
+    r <- asks theRoot
+    a <- getAtom "_NET_ACTIVE_WINDOW"
+    c <- getAtom "WINDOW"
+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]

XMonad/Hooks/ManageDocks.hs

@@ -0,0 +1,194 @@
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
+{-# OPTIONS -fglasgow-exts #-}
+-- deriving Typeable
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ManageDocks
+-- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>
+-- License      : BSD
+--
+-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- This module provides tools to automatically manage 'dock' type programs,
+-- such as gnome-panel, kicker, dzen, and xmobar.
+
+module XMonad.Hooks.ManageDocks (
+    -- * Usage
+    -- $usage
+    manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts)
+    ) where
+
+
+-----------------------------------------------------------------------------
+import XMonad
+import Foreign.C.Types (CLong)
+import Control.Monad
+import XMonad.Layout.LayoutModifier
+
+-- $usage
+-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.ManageDocks
+--
+-- The first component is a 'ManageHook' which recognizes these windows.  To
+-- enable it:
+--
+-- > manageHook = ... <+> manageDocks
+--
+-- The second component is a layout modifier that prevents windows from
+-- overlapping these dock windows.  It is intended to replace xmonad's
+-- so-called "gap" support.  First, you must add it to your list of layouts:
+--
+-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
+-- >                   where  tall = Tall 1 (3/100) (1/2)
+--
+-- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar
+-- to:
+--
+-- > ,((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".
+
+-- |
+-- Detects if the given window is of type DOCK and if so, reveals it, but does
+-- not manage it. If the window has the STRUT property set, adjust the gap accordingly.
+manageDocks :: ManageHook
+manageDocks = checkDock --> doIgnore
+
+-- |
+-- Checks if a window is a DOCK or DESKTOP window
+checkDock :: Query Bool
+checkDock = ask >>= \w -> liftX $ do
+    a <- getAtom "_NET_WM_WINDOW_TYPE"
+    dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
+    desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
+    mbr <- getProp a w
+    case mbr of
+        Just [r] -> return $ elem (fromIntegral r) [dock, desk]
+        _        -> return False
+
+-- |
+-- Gets the STRUT config, if present, in xmonad gap order
+getStrut :: Window -> X [Strut]
+getStrut w = do
+    spa <- getAtom "_NET_WM_STRUT_PARTIAL"
+    sa  <- getAtom "_NET_WM_STRUT"
+    msp <- getProp spa w
+    case msp of
+        Just sp -> return $ parseStrutPartial sp
+        Nothing -> fmap (maybe [] parseStrut) $ getProp sa w
+ where
+    parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
+    parseStrut _ = []
+
+    parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2]
+     = filter (\(_, n, _, _) -> n /= 0)
+        [(L, l, ly1, ly2), (R, r, ry1, ry2), (T, t, tx1, tx2), (B, b, bx1, bx2)]
+    parseStrutPartial _ = []
+
+-- |
+-- Helper to read a property
+getProp :: Atom -> Window -> X (Maybe [CLong])
+getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w
+
+-- |
+-- Goes through the list of windows and find the gap so that all STRUT
+-- settings are satisfied.
+calcGap :: X (Rectangle -> Rectangle)
+calcGap = withDisplay $ \dpy -> do
+    rootw <- asks theRoot
+    -- We don't keep track of dock like windows, so we find all of them here
+    (_,_,wins) <- io $ queryTree dpy rootw
+    struts <- concat `fmap` mapM getStrut wins
+
+    -- we grab the window attributes of the root window rather than checking
+    -- the width of the screen because xlib caches this info and it tends to
+    -- be incorrect after RAndR
+    wa <- io $ getWindowAttributes dpy rootw
+    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
+
+-- | Adjust layout automagically.
+avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a
+avoidStruts = ModifiedLayout (AvoidStruts True)
+
+data AvoidStruts a = AvoidStruts Bool deriving ( Read, Show )
+
+data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)
+instance Message ToggleStruts
+
+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       )
+    R | p (y0, y1) -> (x0           , y0       , mn x1 sx1, y1       )
+    T | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )
+    B | p (x0, x1) -> (x0           , y0       , x1       , mn y1 sy1)
+    _              -> (x0           , y0       , x1       , y1       )
+ where
+    mx a b = max a (b + n)
+    mn a b = min a (b - n)
+    p r = r `overlaps` (l, h)
+
+-- | 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

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

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.SetWMName
+-- Module      :  XMonad.Hooks.SetWMName
 -- Copyright   :  © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com>
 -- License     :  BSD
 --
@@ -17,38 +17,36 @@
 -- Remember that you need to call the setWMName action yourself (at least until
 -- we have startup hooks). E.g., you can bind it in your Config.hs:
 --
--- > ((modMask .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
+-- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack
 --
 -- and press the key combination before running the Java programs (you only
 -- 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
 -- another bug in AWT code (related to insets). For LG3D insets are explicitly
 -- set to 0, while for other WMs the insets are \"guessed\" and the algorithm
 -- fails miserably by guessing absolutely bogus values.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 -----------------------------------------------------------------------------
 
-module XMonadContrib.SetWMName (
+module XMonad.Hooks.SetWMName (
     setWMName) where
 
 import Control.Monad (join)
-import Control.Monad.Reader (asks)
-import Data.Bits ((.|.))
 import Data.Char (ord)
 import Data.List (nub)
 import Data.Maybe (fromJust, listToMaybe, maybeToList)
-import Data.Word (Word8)
+import Foreign.C.Types (CChar)
 
 import Foreign.Marshal.Alloc (alloca)
 
 import XMonad
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Atom
-import Graphics.X11.Xlib.Extras
 
 -- | sets WM name
 setWMName :: String -> X ()
@@ -65,7 +63,7 @@ setWMName name = do
         -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window
         mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]
         -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)
-        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToWord8List name)
+        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)
         -- declare which _NET protocols are supported (append to the list if it exists)
         supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
         changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
@@ -73,8 +71,8 @@ setWMName name = do
     netSupportingWMCheckAtom :: X Atom
     netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
 
-    latin1StringToWord8List :: String -> [Word8]
-    latin1StringToWord8List str = map (fromIntegral . ord) str
+    latin1StringToCCharList :: String -> [CChar]
+    latin1StringToCCharList str = map (fromIntegral . ord) str
 
     getSupportWindow :: X Window
     getSupportWindow = withDisplay $ \dpy -> do

XMonad/Hooks/UrgencyHook.hs

@@ -0,0 +1,187 @@
+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.UrgencyHook
+-- Copyright   :  Devin Mullins <me@twifkak.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- UrgencyHook lets you configure an action to occur when a window demands
+-- your attention. (In traditional WMs, this takes the form of \"flashing\"
+-- on your \"taskbar.\" Blech.)
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.UrgencyHook (
+                                 -- * Usage
+                                 -- $usage
+                                 withUrgencyHook,
+                                 focusUrgent,
+                                 readUrgents, withUrgents,
+                                 urgencyLayoutHook,
+                                 NoUrgencyHook(..), StdoutUrgencyHook(..),
+                                 dzenUrgencyHook, DzenUrgencyHook(..),
+                                 UrgencyHook(urgencyHook),
+                                 seconds
+                                 ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Layout.LayoutModifier hiding (hook)
+import XMonad.Util.Dzen (dzenWithArgs, seconds)
+import XMonad.Util.NamedWindows (getName)
+
+import Control.Monad (when)
+import Data.Bits (testBit, clearBit)
+import Data.IORef
+import Data.List ((\\), delete)
+import Data.Maybe (listToMaybe)
+import qualified Data.Set as S
+import Foreign (unsafePerformIO)
+
+-- $usage
+-- To wire this up, first add:
+--
+-- > import XMonad.Hooks.UrgencyHook
+--
+-- to your import list in your config file. Now, choose an urgency hook. If
+-- you're just interested in displaying the urgency state in your custom
+-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided
+-- 'dzenUrgencyHook', or write your own.
+--
+-- Enable your urgency hook by wrapping your config record in a call to
+-- 'withUrgencyHook'. For example:
+--
+-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
+-- >               $ defaultConfig
+--
+-- If you want to modify your logHook to print out information about urgent windows,
+-- the functions 'readUrgents' and 'withUrgents' are there to help you with that.
+-- No example for you.
+
+-- | This is the preferred method of enabling an urgency hook. It will prepend
+-- an action to your logHook that removes visible windows from the list of urgent
+-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead.
+withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) =>
+                   h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l)
+withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf
+                                 , logHook = removeVisiblesFromUrgents >> logHook conf
+                                 }
+
+-- | The logHook action used by 'withUrgencyHook'.
+removeVisiblesFromUrgents :: X ()
+removeVisiblesFromUrgents = do
+    visibles <- gets mapped
+    adjustUrgents (\\ (S.toList visibles))
+
+-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.
+-- Example keybinding:
+--
+-- > , ((modMask              , xK_BackSpace), focusUrgent)
+focusUrgent :: X ()
+focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe
+
+-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use
+-- 'readUrgents' or 'withUrgents' instead.
+{-# NOINLINE urgents #-}
+urgents :: IORef [Window]
+urgents = unsafePerformIO (newIORef [])
+-- (Hey, I don't like it any more than you do.)
+
+-- | X action that returns a list of currently urgent windows. You might use
+-- it, or 'withUrgents', in your custom logHook, to display the workspaces that
+-- contain urgent windows.
+readUrgents :: X [Window]
+readUrgents = io $ readIORef urgents
+
+-- | An HOF version of 'readUrgents', for those who prefer that sort of thing.
+withUrgents :: ([Window] -> X a) -> X a
+withUrgents f = readUrgents >>= f
+
+data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)
+
+-- The Non-ICCCM Manifesto:
+-- Note: Some non-standard choices have been made in this implementation to
+-- account for the fact that things are different in a tiling window manager:
+--   1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag
+--      9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly.
+--      so in order to prevent that, we immediately clear the urgency flag.
+--   2. In normal window managers, windows may overlap, so clients wait for focus to
+--      be set before urgency is cleared. In a tiling WM, it's sufficient to be able
+--      see the window, since we know that means you can see it completely.
+--   3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window
+--      has focus, and won't clear until it loses and regains focus. This is stupid.
+-- In order to account for these quirks, we clear the urgency bit immediately upon
+-- receiving notification (thus suppressing the repeated notifications) and track
+-- the list of urgent windows ourselves, allowing us to clear urgency when a window
+-- is visible, and not to set urgency if a window is visible.
+-- If you have a better idea, please, let us know!
+instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where
+    handleMess (WithUrgencyHook hook) mess
+      | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do
+          when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
+              wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
+              when (testBit flags urgencyHintBit) $ do
+                  -- Call the urgencyHook.
+                  userCode $ urgencyHook hook w
+                  -- Clear the bit to prevent repeated notifications, as described above.
+                  io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }
+                  -- Add to list of urgents.
+                  adjustUrgents (\ws -> if elem w ws then ws else w : ws)
+                  -- Call logHook after IORef has been modified.
+                  userCode =<< asks (logHook . config)
+          return Nothing
+      | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do
+          adjustUrgents (delete w)
+          return Nothing
+      | otherwise =
+          return Nothing
+
+adjustUrgents :: ([Window] -> [Window]) -> X ()
+adjustUrgents f = io $ modifyIORef urgents f
+
+urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) =>
+                   h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window
+urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook
+
+--------------------------------------------------------------------------------
+-- Urgency Hooks
+
+-- | The class definition, and some pre-defined instances.
+
+class (Read h, Show h) => UrgencyHook h a where
+    urgencyHook :: h -> a -> X ()
+
+data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
+
+instance UrgencyHook NoUrgencyHook Window where
+    urgencyHook _ _ = return ()
+
+data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] }
+    deriving (Read, Show)
+
+instance UrgencyHook DzenUrgencyHook Window where
+    urgencyHook DzenUrgencyHook { duration = d, args = a } w = do
+        visibles <- gets mapped
+        name <- getName w
+        ws <- gets windowset
+        whenJust (W.findTag w ws) (flash name visibles)
+      where flash name visibles index =
+                  when (not $ S.member w visibles) $
+                  dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d
+
+-- | Flashes when a window requests your attention and you can't see it. Configurable
+-- duration and args to dzen.
+dzenUrgencyHook :: DzenUrgencyHook
+dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] }
+
+-- For debugging purposes, really.
+data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
+
+instance UrgencyHook StdoutUrgencyHook Window where
+    urgencyHook    _ w = io $ putStrLn $ "Urgent: " ++ show w

XMonad/Hooks/XPropManage.hs

@@ -1,6 +1,6 @@
 -----------------------------------------------------------------------------
 -- |
--- Module       : XMonadContrib.XPropManage
+-- Module       : XMonad.Hooks.XPropManage
 -- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
 -- License      : BSD
 --
@@ -11,7 +11,7 @@
 -- A ManageHook matching on XProperties.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.XPropManage (
+module XMonad.Hooks.XPropManage (
                  -- * Usage
                  -- $usage
                  xPropManageHook, XPropMatch, pmX, pmP
@@ -19,23 +19,25 @@ module XMonadContrib.XPropManage (
 
 import Data.Char (chr)
 import Data.List (concat)
+import Data.Monoid (mconcat, Endo(..))
 
-import Control.Monad.State
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
+import Control.Monad.Trans (lift)
 
 import XMonad
+import XMonad.ManageHook ((-->))
 
 -- $usage
--- 
--- Add something like the following lines to Config.hs to use this module
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.XPropManage
+-- > import qualified XMonad.StackSet as W
+-- > import XMonad.Actions.TagWindows
+-- > import Data.List
 --
--- > import XMonadContrib.XPropManage
--- 
 -- > manageHook = xPropManageHook xPropMatches 
 -- >
 -- > xPropMatches :: [XPropMatch]
--- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==)))], (\w -> float w >> return (W.shift "2")))
+-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2")))
 -- >                , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen"))
 -- >                , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3"))
 -- >                ]
@@ -64,17 +66,12 @@ pmX f w = f w >> return id
 pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
 pmP f _ = return f
 
-xPropManageHook :: [XPropMatch] -> Window -> X (WindowSet -> WindowSet)
-xPropManageHook tms w = withDisplay $ \d -> do
-    fs <- mapM (matchProp d w `uncurry`) tms
-    return (foldr (.) id fs)
-
-matchProp :: Display -> Window -> [(Atom, [String] -> Bool)] -> (Window -> X (WindowSet -> WindowSet)) -> X (WindowSet -> WindowSet)
-matchProp d w tm tf = do
-    m <- and `liftM` sequence (map (\(k,f) -> f `liftM` getProp d w k) tm)
-    case m of
-        True   -> tf w
-        False  -> return id
+xPropManageHook :: [XPropMatch] -> ManageHook
+xPropManageHook tms = mconcat $ map propToHook tms
+    where
+      propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f
+      mkQuery (a, tf)    = fmap tf (getQuery a)
+      mkHook func        = ask >>= Query . lift . fmap Endo . func 
 
 getProp :: Display -> Window -> Atom -> X ([String])
 getProp d w p = do
@@ -83,9 +80,11 @@ getProp d w p = do
                | otherwise       = id
     return (filt p prop)
 
+getQuery ::  Atom -> Query [String]
+getQuery p = ask >>= \w ->  Query . lift $ withDisplay $ \d -> getProp d w p
+
 splitAtNull :: String -> [String]
 splitAtNull s = case dropWhile (== (chr 0)) s of
     "" -> []
     s' -> w : splitAtNull s''
           where (w, s'') = break (== (chr 0)) s'
-

XMonad/Layout/Accordion.hs

@@ -2,7 +2,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Accordion
+-- Module      :  XMonad.Layout.Accordion
 -- Copyright   :  (c) glasser@mit.edu
 -- License     :  BSD
 --
@@ -14,23 +14,28 @@
 -- of the screen.
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Accordion (
+module XMonad.Layout.Accordion (
     -- * Usage
     -- $usage
     Accordion(Accordion)) where
 
 import XMonad
-import Operations
-import qualified StackSet as W
-import Graphics.X11.Xlib
+import qualified XMonad.StackSet as W
 import Data.Ratio
 
 -- $usage
--- > import XMonadContrib.Accordion
--- > layouts = [ Layout Accordion ]
-
--- %import XMonadContrib.Accordion
--- %layout , Layout Accordion
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Accordion
+--
+-- Then edit your @layoutHook@ by adding the Accordion layout:
+--
+-- > myLayouts = Accordion ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 data Accordion a = Accordion deriving ( Read, Show )
 

XMonad/Layout/Circle.hs

@@ -2,7 +2,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Circle
+-- Module      :  XMonad.Layout.Circle
 -- Copyright   :  (c) Peter De Wachter
 -- License     :  BSD-style (see LICENSE)
 --
@@ -14,24 +14,29 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Circle (
+module XMonad.Layout.Circle (
                              -- * Usage
                              -- $usage
                              Circle (..)
                             ) where -- actually it's an ellipse
 
 import Data.List
-import Graphics.X11.Xlib
 import XMonad
-import StackSet (integrate, peek)
+import XMonad.StackSet (integrate, peek)
 
 -- $usage
--- You can use this module with the following in your Config.hs file:
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.Circle
--- > layouts = [ Layout Circle ]
-
--- %import XMonadContrib.Circle
+-- > import XMonad.Layout.Circle
+--
+-- Then edit your @layoutHook@ by adding the Circle layout:
+--
+-- > myLayouts = Circle ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 data Circle a = Circle deriving ( Read, Show )
 

XMonad/Layout/Combo.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
+             UndecidableInstances, PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- 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
+--
+-- A layout that combines multiple layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Combo (
+                            -- * Usage
+                            -- $usage
+                            combineTwo,
+                            CombineTwo
+                           ) where
+
+import Data.List ( delete, intersect, (\\) )
+import Data.Maybe ( isJust )
+import XMonad hiding (focus)
+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
+--
+-- and add something like
+--
+-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)
+--
+-- to your layouts.
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- combineTwo is a new simple layout combinator. It allows the
+-- combination of two layouts using a third to split the screen
+-- between the two, but has the advantage of allowing you to
+-- dynamically adjust the layout, in terms of the number of windows in
+-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",
+-- and add the following key bindings (or something similar):
+--
+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)
+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)
+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)
+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- These bindings will move a window into the sublayout that is
+-- up\/down\/left\/right of its current position.  Note that there is some
+-- weirdness in combineTwo, in that the mod-tab focus order is not very closely
+-- related to the layout order. This is because we're forced to keep track of
+-- the window positions separately, and this is ugly.  If you don't like this,
+-- lobby for hierarchical stacks in core xmonad or go reimplement the core of
+-- xmonad yourself.
+
+data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a)
+                            deriving (Read, Show)
+
+combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>
+              super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a
+combineTwo = C2 [] []
+
+instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
+    => LayoutClass (CombineTwo (l ()) l1 l2) a where
+    doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s)
+        where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
+                              l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
+                              super' <- maybe super id `fmap`
+                                        handleMessage super (SomeMessage ReleaseResources)
+                              return ([], Just $ C2 [] [] super' l1' l2')
+              arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
+                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
+                               super' <- maybe super id `fmap`
+                                         handleMessage super (SomeMessage ReleaseResources)
+                               return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
+              arrange origws =
+                  do let w2' = case origws `intersect` w2 of [] -> [head origws]
+                                                             [x] -> [x]
+                                                             x -> case origws \\ x of
+                                                                  [] -> init x
+                                                                  _ -> x
+                         superstack = if focus s `elem` w2'
+                                      then Stack { focus=(), up=[], down=[()] }
+                                      else Stack { focus=(), up=[], down=[()] }
+                         s1 = differentiate f' (origws \\ w2')
+                         s2 = differentiate f' w2'
+                         f' = focus s:delete (focus s) f
+                     ([((),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
+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
+          w1 `notElem` ws2,
+          w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
+                             l2' <- maybe l2 id `fmap` handleMessage l2 m
+                             return $ Just $ C2 f (w1:ws2) super l1' l2'
+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
+          w1 `elem` ws2,
+          w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
+                                l2' <- maybe l2 id `fmap` handleMessage l2 m
+                                let ws2' = case delete w1 ws2 of [] -> [w2]
+                                                                 x -> x
+                                return $ Just $ C2 f ws2' super l1' l2'
+        | otherwise = do ml1' <- broadcastPrivate m [l1]
+                         ml2' <- broadcastPrivate m [l2]
+                         msuper' <- broadcastPrivate m [super]
+                         if isJust msuper' || isJust ml1' || isJust ml2'
+                            then return $ Just $ C2 f ws2
+                                                 (maybe super head msuper')
+                                                 (maybe l1 head ml1')
+                                                 (maybe l2 head ml2')
+                            else return Nothing
+    description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "++
+                                       description l2 ++" with "++ description super
+
+
+differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
+differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z
+                                                     , up = reverse $ takeWhile (/=z) xs
+                                                     , down = tail $ dropWhile (/=z) xs }
+                        | otherwise = differentiate zs xs
+differentiate [] xs = W.differentiate xs
+
+broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
+broadcastPrivate a ol = do nml <- mapM f ol
+                           if any isJust nml
+                              then return $ Just $ zipWith ((flip maybe) id) ol nml
+                              else return Nothing
+    where f l = handleMessage l a `catchX` return Nothing

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

@@ -0,0 +1,57 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Dishes
+-- Copyright   :  (c) Jeremy Apthorp
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Jeremy Apthorp <nornagon@gmail.com>
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- Dishes is a layout that stacks extra windows underneath the master
+-- windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Dishes (
+                              -- * Usage
+                              -- $usage
+                              Dishes (..)
+                            ) where
+
+import Data.List
+import XMonad
+import XMonad.StackSet (integrate)
+import Control.Monad (ap)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Dishes
+--
+-- Then edit your @layoutHook@ by adding the Dishes layout:
+--
+-- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data Dishes a = Dishes Int Rational deriving (Show, Read)
+instance LayoutClass Dishes a where
+    doLayout (Dishes nmaster h) r =
+        return . (\x->(x,Nothing)) .
+        ap zip (dishes h r nmaster . length) . integrate
+    pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m)
+        where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h
+
+dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
+dishes h s nmaster n = if n <= nmaster
+                        then splitHorizontally n s
+                        else ws
+ where
+    (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s
+    ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest

XMonad/Layout/DragPane.hs

@@ -3,7 +3,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.DragPane
+-- Module      :  XMonad.Layout.DragPane
 -- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
 --                    David Roundy <droundy@darcs.net>,
 --                    Andrea Rossato <andrea.rossato@unibz.it>
@@ -21,33 +21,33 @@
 
 -----------------------------------------------------------------------------
 
-module XMonadContrib.DragPane (
+module XMonad.Layout.DragPane (
                                -- * Usage
                                -- $usage
                                 dragPane
-                              , DragType (..)
+                              , DragPane, DragType (..)
                               ) where
 
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
 import XMonad
-import Data.Bits
 import Data.Unique
 
-import Operations 
-import qualified StackSet as W 
-import XMonadContrib.Invisible
-import XMonadContrib.XUtils
+import qualified XMonad.StackSet as W 
+import XMonad.Util.Invisible
+import XMonad.Util.XUtils
 
 -- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- You can use this module with the following in your Config.hs file:
+-- > import XMonad.Layout.DragPane
 --
--- > import XMonadContrib.DragPane
+-- Then edit your @layoutHook@ by adding the DragPane layout:
 --
---  and add, to the list of layouts:
+-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
--- > Layout $ dragPane Horizontal 0.1 0.5
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 halfHandleWidth :: Integral a => a
 halfHandleWidth = 1
@@ -64,7 +64,7 @@ data DragPane a =
 
 data DragType = Horizontal | Vertical deriving ( Show, Read )
 
-instance LayoutClass DragPane Window where
+instance LayoutClass DragPane a where
     doLayout d@(DragPane _ Vertical   _ _) = doLay id d
     doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
     handleMessage = handleMess
@@ -72,7 +72,7 @@ instance LayoutClass DragPane Window where
 data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
 instance Message SetFrac
 
-handleMess :: DragPane Window -> SomeMessage -> X (Maybe (DragPane Window)) 
+handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))
 handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
     | Just e <- fromMessage x :: Maybe Event = do handleEvent d e
                                                   return Nothing
@@ -87,19 +87,19 @@ handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
                                      return $ Just (DragPane mb ty delta frac)
 handleMess _ _ = return Nothing
 
-handleEvent :: DragPane Window -> Event -> X ()
+handleEvent :: DragPane a -> Event -> X ()
 handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) 
             (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
     | t == buttonPress && thisw == win || thisbw == win  = do
   mouseDrag (\ex ey -> do
              let frac = case ty of
-                          Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)
-                          Horizontal -> (fromIntegral ey - (fromIntegral $ rect_y r))/(fromIntegral $ rect_height r)
+                        Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)
+                        Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)
              sendMessage (SetFrac ident frac))
             (return ())
 handleEvent _ _  = return ()
 
-doLay :: (Rectangle -> Rectangle) -> DragPane Window -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
+doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))
 doLay mirror (DragPane mw ty delta split) r s = do
   let r' = mirror r
       (left', right') = splitHorizontallyBy split r'
@@ -107,7 +107,7 @@ doLay mirror (DragPane mw ty delta split) r s = do
                                mirror $ Rectangle x y (w-halfHandleWidth) h
       right = case right' of
                 Rectangle x y w h ->
-		    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
+                    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
       handr = case left' of
                 Rectangle x y w h ->
                     mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
@@ -131,6 +131,6 @@ doLay mirror (DragPane mw ty delta split) r s = do
 newDragWin :: Rectangle -> X Window
 newDragWin r = do
   let mask = Just $ exposureMask .|. buttonPressMask
-  w <- createNewWindow r mask handleColor
+  w <- createNewWindow r mask handleColor False
   showWindow  w
   return      w

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

@@ -0,0 +1,66 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Grid
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A simple layout that attempts to put all windows in a square grid.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Grid (
+    -- * Usage
+    -- $usage
+        Grid(..), arrange
+) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Grid
+--
+-- Then edit your @layoutHook@ by adding the Grid layout:
+--
+-- > myLayouts = Grid ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data Grid a = Grid deriving (Read, Show)
+
+instance LayoutClass Grid a where
+    pureLayout Grid r s = arrange r (integrate s)
+
+arrange :: Rectangle -> [a] -> [(a, Rectangle)]
+arrange (Rectangle rx ry rw rh) st = zip st rectangles
+        where
+        nwins = length st
+        ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins
+        mincs = nwins `div` ncols
+        extrs = nwins - ncols * mincs
+        chop :: Int -> Dimension -> [(Position, Dimension)]
+        chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'
+                where
+                k :: Dimension
+                k = m `div` fromIntegral n
+                m' = fromIntegral m
+                k' :: Position
+                k' = fromIntegral k
+        xcoords = chop ncols rw
+        ycoords = chop mincs rh
+        ycoords' = chop (succ mincs) rh
+        (xbase, xext) = splitAt (ncols - extrs) xcoords
+        rectangles = combine ycoords xbase ++ combine ycoords' xext
+                where
+                combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]

XMonad/Layout/HintedTile.hs

@@ -0,0 +1,125 @@
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.HintedTile
+-- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
+--                Andrea Rossato <andrea.rossato@unibz.it>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A gapless tiled layout that attempts to obey window size hints,
+-- rather than simply ignoring them.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.HintedTile (
+    -- * Usage
+    -- $usage
+    HintedTile(..), Orientation(..), Alignment(..)
+) where
+
+import XMonad hiding (Tall(..))
+import qualified XMonad.StackSet as W
+import Control.Applicative ((<$>))
+import Control.Monad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.HintedTile
+--
+-- Then edit your @layoutHook@ by adding the HintedTile layout:
+--
+-- > 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:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data HintedTile a = HintedTile
+    { nmaster     :: Int
+    , delta, frac :: Rational
+    , alignment   :: Alignment
+    , orientation :: Orientation
+    } 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, 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 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)
+     where
+        resize Shrink = c { frac = max 0 $ frac c - delta c }
+        resize Expand = c { frac = min 1 $ frac c + delta c }
+        incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d }
+
+    description l = show (orientation l)
+
+adjBorder :: Dimension -> Dimension -> D -> D
+adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b)
+
+-- | Transform a function on dimensions into one without regard for borders
+hintsUnderBorder :: (Dimension, SizeHints) -> D -> D
+hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1)
+
+getHints :: Window -> X (Dimension, SizeHints)
+getHints w = withDisplay $ \d -> io $ liftM2 (,)
+    (fromIntegral . wa_border_width <$> getWindowAttributes d w)
+    (getWMNormalHints d w)
+
+align :: Alignment -> Position -> Dimension -> Dimension -> Position
+align TopLeft     p _ _ = p
+align Center      p a b = p + fromIntegral (a - b) `div` 2
+align BottomRight p a b = p + fromIntegral (a - b)
+
+-- Divide the screen vertically (horizontally) into n subrectangles
+divide :: 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)
+
+-- Split the screen into two rectangles, using a rational to specify the ratio
+split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])
+      -> (Rectangle -> [Rectangle]) -> [Rectangle]
+split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects
+ where
+    leftw = floor $ fromIntegral sw * f
+    leftRects = left $ Rectangle sx sy leftw sh
+    rightx = (maximum . map rect_width) leftRects
+    rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh
+
+split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects
+ where
+    toph = floor $ fromIntegral sh * f
+    topRects = top $ Rectangle sx sy sw toph
+    bottomy = (maximum . map rect_height) topRects
+    bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)

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

@@ -0,0 +1,280 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Layout.LayoutCombinators
+-- Copyright    : (c) David Roundy <droundy@darcs.net>
+-- License      : BSD
+--
+-- Maintainer   : David Roundy <droundy@darcs.net>
+-- Stability    : unstable
+-- Portability  : portable
+--
+-- 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
+
+      -- * Layout combinators
+      -- $combine
+
+      -- ** Combinators using DragPane vertical
+      -- $dpv
+      (*||*), (**||*),(***||*),(****||*),(***||**),(****||***)
+    , (***||****),(*||****),(**||***),(*||***),(*||**)
+
+      -- ** Combinators using DragPane horizontal
+      -- $dph
+    , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)
+    , (***//****),(*//****),(**//***),(*//***),(*//**)
+
+      -- ** Combinators using Tall (vertical)
+      -- $tv
+    , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)
+    , (***|****),(*|****),(**|***),(*|***),(*|**)
+
+      -- ** 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
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )
+--
+-- 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:
+--
+-- "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 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**,
+         *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**,
+         *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** ,
+         */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**
+
+-- $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
+
+(*||*)      = combineTwo (dragPane Vertical 0.1 (1/2))
+(**||*)     = combineTwo (dragPane Vertical 0.1 (2/3))
+(***||*)    = combineTwo (dragPane Vertical 0.1 (3/4))
+(****||*)   = combineTwo (dragPane Vertical 0.1 (4/5))
+(***||**)   = combineTwo (dragPane Vertical 0.1 (3/5))
+(****||***) = combineTwo (dragPane Vertical 0.1 (4/7))
+(***||****) = combineTwo (dragPane Vertical 0.1 (3/7))
+(*||****)   = combineTwo (dragPane Vertical 0.1 (1/5))
+(**||***)   = combineTwo (dragPane Vertical 0.1 (2/5))
+(*||***)    = combineTwo (dragPane Vertical 0.1 (1/4))
+(*||**)     = combineTwo (dragPane Vertical 0.1 (1/3))
+
+-- $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
+
+(*//*)      = combineTwo (dragPane Horizontal 0.1 (1/2))
+(**//*)     = combineTwo (dragPane Horizontal 0.1 (2/3))
+(***//*)    = combineTwo (dragPane Horizontal 0.1 (3/4))
+(****//*)   = combineTwo (dragPane Horizontal 0.1 (4/5))
+(***//**)   = combineTwo (dragPane Horizontal 0.1 (3/5))
+(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7))
+(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7))
+(*//****)   = combineTwo (dragPane Horizontal 0.1 (1/5))
+(**//***)   = combineTwo (dragPane Horizontal 0.1 (2/5))
+(*//***)    = combineTwo (dragPane Horizontal 0.1 (1/4))
+(*//**)     = combineTwo (dragPane Horizontal 0.1 (1/3))
+
+-- $tv
+-- 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
+(*|*)      = combineTwo (Tall 1 0.1 (1/2))
+(**|*)     = combineTwo (Tall 1 0.1 (2/3))
+(***|*)    = combineTwo (Tall 1 0.1 (3/4))
+(****|*)   = combineTwo (Tall 1 0.1 (4/5))
+(***|**)   = combineTwo (Tall 1 0.1 (3/5))
+(****|***) = combineTwo (Tall 1 0.1 (4/7))
+(***|****) = combineTwo (Tall 1 0.1 (3/7))
+(*|****)   = combineTwo (Tall 1 0.1 (1/5))
+(**|***)   = combineTwo (Tall 1 0.1 (2/5))
+(*|***)    = combineTwo (Tall 1 0.1 (1/4))
+(*|**)     = combineTwo (Tall 1 0.1 (1/3))
+
+
+-- $mth
+-- 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
+(*/*)      = combineTwo (Mirror $ Tall 1 0.1 (1/2))
+(**/*)     = combineTwo (Mirror $ Tall 1 0.1 (2/3))
+(***/*)    = combineTwo (Mirror $ Tall 1 0.1 (3/4))
+(****/*)   = combineTwo (Mirror $ Tall 1 0.1 (4/5))
+(***/**)   = combineTwo (Mirror $ Tall 1 0.1 (3/5))
+(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7))
+(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7))
+(*/****)   = combineTwo (Mirror $ Tall 1 0.1 (1/5))
+(**/***)   = combineTwo (Mirror $ Tall 1 0.1 (2/5))
+(*/***)    = combineTwo (Mirror $ Tall 1 0.1 (1/4))
+(*/**)     = combineTwo (Mirror $ Tall 1 0.1 (1/3))
+
+infixr 5 |||
+
+-- $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
+
+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
+    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
+        | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m
+    handleMessage l@(NewSelect amfirst _ _) m
+        | Just NextLayoutNoWrap <- fromMessage m =
+                  if amfirst then when' isNothing (passOnM m l) $
+                                  fmap Just $ swap l >>= passOn (SomeMessage Wrap)
+                             else passOnM m l
+    handleMessage l m
+        | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
+                                             fmap Just $ swap l >>= passOn (SomeMessage Wrap)
+    handleMessage l@(NewSelect True _ l2) m
+        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l
+    handleMessage l@(NewSelect False l1 _) m
+        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l
+    handleMessage l m
+        | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
+                                                   do ml' <- passOnM m $ sw l
+                                                      case ml' of
+                                                        Nothing -> return Nothing
+                                                        Just l' -> Just `fmap` swap (sw l')
+    handleMessage (NewSelect b l1 l2) m
+        | Just ReleaseResources  <- fromMessage m =
+        do ml1' <- handleMessage l1 m
+           ml2' <- handleMessage l2 m
+           return $ if isJust ml1' || isJust ml2'
+                    then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')
+                    else Nothing
+    handleMessage l m = passOnM m l
+
+swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
+swap l = sw `fmap` passOn (SomeMessage Hide) l
+
+sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
+sw (NewSelect b lt lf) = NewSelect (not b) lt lf
+
+passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
+          SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
+passOn m l = maybe l id `fmap` passOnM m l
+
+passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
+           SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
+passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
+                                      return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'
+passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
+                                       return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'
+
+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

@@ -0,0 +1,63 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Layout.LayoutHints
+-- Copyright    : (c) David Roundy <droundy@darcs.net>
+-- License      : BSD
+--
+-- Maintainer   : David Roundy <droundy@darcs.net>
+-- Stability    : unstable
+-- Portability  : portable
+--
+-- Make layouts respect size hints.
+-----------------------------------------------------------------------------
+
+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@:
+--
+-- > import XMonad.Layout.LayoutHints
+--
+-- Then edit your @layoutHook@ by adding the LayoutHints layout modifier
+-- to some layout:
+--
+-- > myLayouts = layoutHints (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"
+
+layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
+layoutHints = ModifiedLayout LayoutHints
+
+-- | Expand a size by the given multiple of the border width.  The
+-- multiple is most commonly 1 or -1.
+adjBorders                :: Dimension -> Dimension -> D -> D
+adjBorders bW mult (w,h)  = (w+2*mult*bW, h+2*mult*bW)
+
+data LayoutHints a = LayoutHints deriving (Read, Show)
+
+instance LayoutModifier LayoutHints Window where
+    modifierDescription _ = "Hinted"
+    redoLayout _ _ s xs = do
+                            bW <- asks (borderWidth . config)
+                            xs' <- mapM (applyHint bW) xs
+                            return (xs', Nothing)
+     where
+        applyHint bW (w,r@(Rectangle a b c d)) =
+            withDisplay $ \disp -> do
+                sh  <- io $ getWMNormalHints disp w
+                let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d)
+                return (w, if isInStack s w then Rectangle a b c' d' else r)

XMonad/Layout/LayoutModifier.hs

@@ -0,0 +1,285 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Layout.LayoutModifier
+-- Copyright    : (c) David Roundy <droundy@darcs.net>
+-- License      : BSD
+--
+-- Maintainer   : David Roundy <droundy@darcs.net>
+-- Stability    : unstable
+-- Portability  : portable
+--
+-- 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, Workspace (..) )
+
+-- $usage
+--
+-- The 'LayoutModifier' class is provided to help extension developers
+-- write easy layout modifiers.  End users won't find much of interest
+-- here. =)
+--
+-- 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 $ 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')
+
+    -- | '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 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
+    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'
+           return (ws', ml'')
+
+    handleMessage (ModifiedLayout m l) mess =
+        do mm' <- handleMessOrMaybeModifyIt m mess
+           ml' <- case mm' of
+                  Just (Right mess') -> handleMessage l mess'
+                  _ -> handleMessage l mess
+           return $ case mm' of
+                    Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
+                    _ -> (ModifiedLayout m) `fmap` ml'
+    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

@@ -2,7 +2,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.LayoutScreens
+-- Module      :  XMonad.Layout.LayoutScreens
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -12,19 +12,14 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.LayoutScreens (
+module XMonad.Layout.LayoutScreens (
                                     -- * Usage
                                     -- $usage
                                     layoutScreens, fixedLayout
                                    ) where
 
-import Control.Monad.Reader ( asks )
-
 import XMonad
-import qualified StackSet as W
-import qualified Operations as O
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- This module allows you to pretend that you have more than one screen by
@@ -35,33 +30,36 @@ import Graphics.X11.Xlib.Extras
 -- screen and long for greater flexibility (e.g. being able to see your
 -- email window at all times, a crude mimic of sticky windows).
 --
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.LayoutScreens
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@ file:
 --
--- >   , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
+-- > import XMonad.Layout.LayoutScreens
+-- > import XMonad.Layout.TwoPane
+--
+-- Then add some keybindings; for example:
+--
+-- >   , ((modMask x .|. shiftMask,                 xK_space), layoutScreens 2 (TwoPane 0.5 0.5))
+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)
 --
 -- Another example use would be to handle a scenario where xrandr didn't
 -- work properly (e.g. a VNC X server in my case) and you want to be able
 -- to resize your screen (e.g. to match the size of a remote VNC client):
--- 
--- > import XMonadContrib.LayoutScreens
 --
--- >   , ((modMask .|. shiftMask, xK_space),
--- >        layoutScreens 1 (fixedLayout $ Rectangle 0 0 1024 768))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
-
--- %import XMonadContrib.LayoutScreens
--- %keybind , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5))
--- %keybind , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
+-- > import XMonad.Layout.LayoutScreens
+--
+-- >   , ((modMask x .|. shiftMask, xK_space),
+-- >        layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))
+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 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] }
-       O.windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
+       (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect
+       windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
            let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs
                gaps = map (statusGap . W.screenDetail) $ v:vs
                (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps))

XMonad/Layout/MagicFocus.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Layout.MagicFocus
+-- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Peter De Wachter <pdewacht@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Automagically put the focused window in the master area.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.MagicFocus
+    (-- * Usage
+     -- $usage
+     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
+-- modifier:
+--
+-- > 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"
+
+-- | Create a new layout which automagically puts the focused window
+--   in the master area.
+magicFocus :: l a -> ModifiedLayout MagicFocus l a
+magicFocus = ModifiedLayout MagicFocus
+
+data MagicFocus a = MagicFocus deriving (Show, Read)
+
+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)
+                           | otherwise         = Stack f u d

XMonad/Layout/Magnifier.hs

@@ -0,0 +1,160 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Magnifier
+-- Copyright   :  (c) Peter De Wachter and Andrea Rossato 2007
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Screenshot  :  <http://caladan.rave.org/magnifier.png>
+--
+-- This is a layout modifier that will make a layout increase the size
+-- of the window that has focus.
+--
+-----------------------------------------------------------------------------
+
+
+module XMonad.Layout.Magnifier
+    ( -- * Usage
+      -- $usage
+      magnifier,
+      magnifier',
+      magnifierOff,
+      magnifiercz,
+      magnifiercz',
+      MagnifyMsg (..)
+    ) 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.Magnifier
+--
+-- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier
+-- to some layout:
+--
+-- > myLayouts = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- By default magnifier increases the focused window's size by 1.5.
+-- You can also use:
+--
+-- > magnifiercz 1.2
+--
+-- to use a custom level of magnification.  You can even make the focused
+-- window smaller for a pop in effect.
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- Magnifier supports some commands. To use them add something like
+-- this to your key bindings:
+--
+-- >    , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)
+-- >    , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)
+-- >    , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )
+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )
+-- >    , ((modMask x .|. controlMask              , xK_m    ), sendMessage Toggle     )
+--
+-- Note that a few other extension modules, such as
+-- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also
+-- define a message named 'Toggle'.  To avoid conflicts when using
+-- these modules together, you can import Magnifier qualified, like
+-- this:
+--
+-- > import qualified XMonad.Layout.Magnifier as Mag
+--
+-- and then prefix @Mag@ to the front of everything from this module,
+-- like @Mag.Toggle@, @Mag.magnifier@, and so on.
+--
+-- For detailed instruction on editing the key binding see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Increase the size of the window that has focus
+magnifier :: l a -> ModifiedLayout Magnifier l a
+magnifier = ModifiedLayout (Mag 1.5 On All)
+
+-- | Change the size of the window that has focus by a custom zoom
+magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
+magnifiercz cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On All)
+
+-- | Increase the size of the window that has focus, unless if it is the
+-- master window.
+magnifier' :: l a -> ModifiedLayout Magnifier l a
+magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)
+
+-- | Magnifier 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 | Toggle deriving ( Typeable )
+instance Message MagnifyMsg
+
+data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show)
+
+type Zoom = Double
+
+data Toggle        = On  | Off      deriving  (Read, Show)
+data MagnifyMaster = All | NoMaster deriving  (Read, Show)
+
+instance LayoutModifier Magnifier Window where
+    redoLayout  (Mag z On All     ) = applyMagnifier z
+    redoLayout  (Mag z On NoMaster) = unlessMaster $ applyMagnifier z
+    redoLayout  _                   = nothing
+        where nothing _ _ wrs = return (wrs, Nothing)
+
+    handleMess (Mag z On  t) m
+                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On  t)
+                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On  t)
+                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z      ) 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"
+    modifierDescription (Mag _ On  NoMaster) = "Magnifier NoMaster"
+    modifierDescription (Mag _ Off _       ) = "Magnifier (off)"
+
+type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))
+
+unlessMaster :: NewLayout a -> NewLayout a
+unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
+                                              else mainmod r s wrs
+
+applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a)
+applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)
+                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)]
+                                                | otherwise         = (w,wr) : ws
+                              return (reverse $ foldr mag [] wrs, Nothing)
+
+magnify :: Double -> Rectangle -> Rectangle
+magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h'
+    where x' = x - fromIntegral (w' - w) `div` 2
+          y' = y - fromIntegral (h' - h) `div` 2
+          w' = round $ fromIntegral w * zoom
+          h' = round $ fromIntegral h * zoom
+
+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/Maximize.hs

@@ -3,7 +3,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Maximize
+-- Module      :  XMonad.Layout.Maximize
 -- Copyright   :  (c) 2007 James Webb
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -16,33 +16,39 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Maximize (
+module XMonad.Layout.Maximize (
         -- * Usage
         -- $usage
         maximize,
         maximizeRestore
     ) where
 
-import Graphics.X11.Xlib
 import XMonad
-import XMonadContrib.LayoutModifier
+import XMonad.Layout.LayoutModifier
 import Data.List ( partition )
 
 -- $usage
--- You can use this module with the following in your Config.hs file:
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.Maximize
+-- > import XMonad.Layout.Maximize
 --
--- > layouts = ...
--- >                  , Layout $ maximize $ tiled ...
--- >                  ...
+-- Then edit your @layoutHook@ by adding the Maximize layout modifier:
 --
--- > keys = ...
--- >        , ((modMask, xK_backslash), withFocused (sendMessage . maximizeRestore))
+-- > myLayouts = maximize (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"
+--
+-- In the key-bindings, do something like:
+--
+-- >        , ((modMask x, xK_backslash), withFocused (sendMessage . maximizeRestore))
 -- >        ...
-
--- %import XMonadContrib.Maximize
--- %layout , Layout $ maximize $ tiled
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 data Maximize a = Maximize (Maybe Window) deriving ( Read, Show )
 maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window

XMonad/Layout/MosaicAlt.hs

@@ -3,7 +3,7 @@
 
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.MosaicAlt
+-- Module      :  XMonad.Layout.MosaicAlt
 -- Copyright   :  (c) 2007 James Webb
 -- License     :  BSD-style (see xmonad/LICENSE)
 -- 
@@ -17,7 +17,7 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.MosaicAlt (
+module XMonad.Layout.MosaicAlt (
         -- * Usage:
         -- $usage
         MosaicAlt(..)
@@ -29,33 +29,38 @@ module XMonadContrib.MosaicAlt (
     ) where
 
 import XMonad
-import Operations
-import Graphics.X11.Xlib
-import qualified StackSet as W
+import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 import Data.List ( sortBy )
 import Data.Ratio
-import Graphics.X11.Types ( Window )
 
 -- $usage
--- You can use this module with the following in your configuration file:
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.MosaicAlt
+-- > import XMonad.Layout.MosaicAlt
+-- > import qualified Data.Map as M
 --
--- > layouts = ...
--- >                  , Layout $ MosaicAlt M.empty
--- >                  ...
+-- Then edit your @layoutHook@ by adding the MosaicAlt layout:
 --
--- > keys = ...
--- >     , ((modMask .|. shiftMask, xK_a), withFocused (sendMessage . expandWindowAlt))
--- >     , ((modMask .|. shiftMask, xK_z), withFocused (sendMessage . shrinkWindowAlt))
--- >     , ((modMask .|. shiftMask, xK_s), withFocused (sendMessage . tallWindowAlt))
--- >     , ((modMask .|. shiftMask, xK_d), withFocused (sendMessage . wideWindowAlt))
--- >     , ((modMask .|. controlMask, xK_space), sendMessage resetAlt)
+-- > myLayouts = MosaicAlt M.empty ||| 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:
+--
+-- >     , ((modMask x .|. shiftMask  , xK_a    ), withFocused (sendMessage . expandWindowAlt))
+-- >     , ((modMask x .|. shiftMask  , xK_z    ), withFocused (sendMessage . shrinkWindowAlt))
+-- >     , ((modMask x .|. shiftMask  , xK_s    ), withFocused (sendMessage . tallWindowAlt))
+-- >     , ((modMask x .|. shiftMask  , xK_d    ), withFocused (sendMessage . wideWindowAlt))
+-- >     , ((modMask x .|. controlMask, xK_space), sendMessage resetAlt)
 -- >     ...
-
--- %import XMonadContrib.MosaicAlt
--- %layout , Layout $ MosaicAlt M.empty
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 data HandleWindowAlt =
     ShrinkWindowAlt Window

XMonad/Layout/MultiToggle.hs

@@ -0,0 +1,239 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.MultiToggle
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Dynamically apply and unapply transformers to your window layout. This can
+-- be used to rotate your window layout by 90 degrees, or to make the
+-- currently focused window occupy the whole screen (\"zoom in\") then undo
+-- the transformation (\"zoom out\").
+
+
+module XMonad.Layout.MultiToggle (
+    -- * Usage
+    -- $usage
+    Transformer(..),
+    Toggle(..),
+    (??),
+    EOT(..),
+    single,
+    mkToggle
+) where
+
+import XMonad
+
+import XMonad.StackSet (Workspace(..))
+
+import Control.Arrow
+import Data.Typeable
+import Data.Maybe
+
+-- $usage
+-- The basic idea is to have a base layout and a set of layout transformers,
+-- of which at most one is active at any time. Enabling another transformer
+-- first disables any currently active transformer; i.e. it works like a
+-- group of radio buttons.
+--
+-- A side effect of this meta-layout is that layout transformers no longer
+-- receive any messages; any message not handled by MultiToggle itself will
+-- undo the current layout transformer, pass the message on to the base
+-- layout, then reapply the transformer.
+--
+-- To use this module, you first have to define the transformers that you
+-- want to be handled by @MultiToggle@. For example, if the transformer is
+-- 'XMonad.Layout.Mirror':
+--
+-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)
+-- > instance Transformer MIRROR Window where
+-- >     transform _ x k = k (Mirror x)
+--
+-- @MIRROR@ can be any identifier (it has to start with an uppercase letter,
+-- of course); I've chosen an all-uppercase version of the transforming
+-- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@
+-- at the beginning of your file to be able to derive "Data.Typeable".
+--
+-- Somewhere else in your file you probably have a definition of @layout@;
+-- the default looks like this:
+--
+-- > layout = tiled ||| Mirror tiled ||| Full
+--
+-- After changing this to
+--
+-- > layout = mkToggle (single MIRROR) (tiled ||| Full)
+--
+-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation:
+--
+-- > ...
+-- >   , ((modMask,               xK_x     ), sendMessage $ Toggle MIRROR)
+-- > ...
+--
+-- (That should be part of your key bindings.) When you press @mod-x@, the
+-- active layout is mirrored. Another @mod-x@ and it's back to normal.
+--
+-- It's also possible to stack @MultiToggle@s. Let's define a few more
+-- transformers ('XMonad.Layout.NoBorders.noBorders' is in
+-- "XMonad.Layout.NoBorders"):
+--
+-- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable)
+-- > instance Transformer NOBORDERS Window where
+-- >     transform _ x k = k (noBorders x)
+-- >
+-- > data FULL = FULL deriving (Read, Show, Eq, Typeable)
+-- > instance Transformer FULL Window where
+-- >     transform _ x k = k Full
+--
+-- @
+-- layout = id
+--     . 'XMonad.Layout.NoBorders.smartBorders'
+--     . mkToggle (NOBORDERS ?? FULL ?? EOT)
+--     . mkToggle (single MIRROR)
+--     $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle'
+-- @
+--
+-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily
+-- maximize windows, in addition to being able to rotate layouts and remove
+-- window borders.
+
+-- | A class to identify custom transformers (and look up transforming
+-- functions by type).
+class (Eq t, Typeable t) => Transformer t a | t -> a where
+    transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b
+
+data EL a = forall l. (LayoutClass l a) => EL (l a)
+
+unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b
+unEL (EL x) k = k x
+
+transform' :: (Transformer t a) => t -> EL a -> EL a
+transform' t el = el `unEL` \l -> transform t l EL
+
+-- | Toggle the specified layout transformer.
+data Toggle a = forall t. (Transformer t a) => Toggle t
+    deriving (Typeable)
+
+instance (Typeable a) => Message (Toggle a)
+
+data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts
+    deriving (Read, Show)
+
+data MultiToggle ts l a = MultiToggle{
+    baseLayout :: l a,
+    currLayout :: EL a,
+    currIndex :: Maybe Int,
+    currTrans :: EL a -> EL a,
+    transformers :: ts
+}
+
+expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a
+expand (MultiToggleS b i ts) =
+    resolve ts (fromMaybe (-1) i) id
+        (\x mt ->
+            let g = transform' x in
+            mt{
+                currLayout = g . EL $ baseLayout mt,
+                currTrans = g
+            }
+        )
+        (MultiToggle b (EL b) i id ts)
+
+collapse :: MultiToggle ts l a -> MultiToggleS ts l a
+collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt)
+
+instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where
+    readsPrec p s = map (first expand) $ readsPrec p s
+
+instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where
+    showsPrec p = showsPrec p . collapse
+
+-- | Construct a @MultiToggle@ layout from a transformer table and a base
+-- layout.
+mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a
+mkToggle ts l = MultiToggle l (EL l) Nothing id ts
+
+-- | Marks the end of a transformer list.
+data EOT = EOT deriving (Read, Show)
+data HCons a b = HCons a b deriving (Read, Show)
+
+infixr 0 ??
+-- | Prepend an element to a heterogeneous list. Used to build transformer
+-- tables for 'mkToggle'.
+(??) :: (HList b w) => a -> b -> HCons a b
+(??) = HCons
+
+-- | Construct a singleton transformer table.
+single :: a -> HCons a EOT
+single = (?? EOT)
+
+class HList c a where
+    find :: (Transformer t a) => c -> t -> Maybe Int
+    resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b
+
+instance HList EOT w where
+    find EOT _ = Nothing
+    resolve EOT _ d _ = d
+
+instance (Transformer a w, HList b w) => HList (HCons a b) w where
+    find (HCons x xs) t
+        | t `geq` x = Just 0
+        | otherwise = fmap succ (find xs t)
+    resolve (HCons x xs) n d k =
+        case n `compare` 0 of
+            LT -> d
+            EQ -> k x
+            GT -> resolve xs (pred n) d k
+
+geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool
+geq a b = Just a == cast b
+
+acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c
+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
+
+    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
+        , i@(Just _) <- find (transformers mt) t
+            = currLayout mt `unEL` \l ->
+            if i == currIndex mt
+                then do
+                    handleMessage l (SomeMessage ReleaseResources)
+                    return . Just $
+                        mt{
+                            currLayout = EL $ baseLayout mt,
+                            currIndex = Nothing,
+                            currTrans = id
+                        }
+                else do
+                    handleMessage l (SomeMessage ReleaseResources)
+                    let f = transform' t
+                    return . Just $
+                        mt{
+                            currLayout = f . EL $ baseLayout mt,
+                            currIndex = i,
+                            currTrans = f
+                        }
+        | fromMessage m == Just ReleaseResources ||
+          fromMessage m == Just Hide
+            = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m)
+        | otherwise = do
+            ml <- handleMessage (baseLayout mt) m
+            case ml of
+                Nothing -> return Nothing
+                Just b' -> currLayout mt `unEL` \l -> do
+                    handleMessage l (SomeMessage ReleaseResources)
+                    return . Just $
+                        mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' }

XMonad/Layout/Named.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Named
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for assigning a name to a given layout.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Named
+    ( -- * Usage
+      -- $usage
+      named
+    ) where
+
+import XMonad.Layout.LayoutModifier
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Named
+--
+-- Then edit your @layoutHook@ by adding the Named layout modifier
+-- to some layout:
+--
+-- > 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"
+
+named :: String -> l a -> ModifiedLayout Named l a
+named s = ModifiedLayout (Named s)
+
+data Named a = Named String deriving ( Read, Show )
+
+instance LayoutModifier Named a where
+    modifyDescription (Named n) _ = n