depend on xmonad-0.6

The initial patch that extended the EDSL for writing ManageHook rules did not come with a good example on how to use it.  This patch ammends that. 'move' is an example of how to write a rule to resolve a Query (Maybe a) into something tangible.  'move'' is an example of how to write a rule isolating window managing code from the rest ofthe mess the EDSL creates.

Accordion.hs

@@ -1,49 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Accordion
--- Copyright   :  (c) glasser@mit.edu
--- License     :  BSD
---
--- Maintainer  :  glasser@mit.edu
--- Stability   :  unstable
--- Portability :  unportable
---
--- Layout that puts non-focused windows in ribbons at the top and bottom
--- of the screen.
------------------------------------------------------------------------------
-
-module XMonadContrib.Accordion (
-    -- * Usage
-    -- $usage
-    accordion) where
-
-import XMonad
-import Operations
-import qualified StackSet as W
-import Graphics.X11.Xlib
-import Data.Ratio
-import XMonadContrib.LayoutHelpers ( idModify )
-
--- $usage
--- > import XMonadContrib.Accordion
--- > defaultLayouts = [ accordion ]
-
-accordion :: Eq a => Layout a
-accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify }
-
-accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
-accordionLayout sc ws = return ((zip ups tops) ++
-                                [(W.focus ws, mainPane)] ++
-                                (zip dns bottoms)
-                               ,Nothing)
- where ups    = W.up ws
-       dns    = W.down ws
-       (top, allButTop) = splitVerticallyBy (1%8) sc
-       (center, bottom) = splitVerticallyBy (6%7) allButTop
-       (allButBottom, _) = splitVerticallyBy (7%8) sc
-       mainPane | ups /= [] && dns /= [] = center
-                | ups /= []              = allButTop
-                | dns /= []              = allButBottom
-                | otherwise              = sc
-       tops   = if ups /= [] then splitVertically (length ups) top else []
-       bottoms= if dns /= [] then splitVertically (length dns) bottom else []

Combo.hs

@@ -1,74 +0,0 @@
------------------------------------------------------------------------------
--- |
--- 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.Maybe ( isJust )
-import XMonad
-import StackSet ( integrate, differentiate )
-
--- $usage
---
--- To use this layout write, in your Config.hs:
--- 
--- > import XMonadContrib.Combo 
--- > import XMonadContrib.SimpleStacking
--- 
--- and add something like
--- 
--- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText,1)]
---
--- to your defaultLayouts.
---
--- 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 subscreents.
--- 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.
-
-combo :: Layout (Layout a, Int) -> [(Layout a, Int)] -> Layout a
-combo super origls = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message }
-    where arrange _ [] = return ([], Nothing)
-          arrange r [w] = return ([(w,r)], Nothing)
-          arrange rinput origws =
-              do (lrs, msuper') <- runLayout super rinput (differentiate $ take (length origws) origls)
-                 let super' = maybe super id msuper'
-                     lwrs [] _ = []
-                     lwrs [((l,_),r)] ws = [((l,r),differentiate ws)]
-                     lwrs (((l,n),r):xs) ws = ((l,r),differentiate $ 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 super' origls')
-          message 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 super' $ maybe origls id mls'
-                           _ -> return $ combo super `fmap` mls'
-
-broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout 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 = modifyLayout l a `catchX` return Nothing

Commands.hs

@@ -1,101 +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 XMonadContrib.Dmenu (dmenu)
-import {-# SOURCE #-} Config (workspaces)
-
-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)
---
--- 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!)
-
-commandMap :: [(String, X ())] -> M.Map String (X ())
-commandMap c = M.fromList c
-
-workspaceCommands :: [(String, X ())]
-workspaceCommands = [((m ++ show i), f i)
-                         | i <- workspaces
-                         , (f, m) <- [(view, "view"), (shift, "shift")]
-                    ]
-
-screenCommands :: [(String, X ())]
-screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust 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)
-                     , ("restart-wm", restart Nothing True)
-                     , ("restart-wm-no-resume", restart Nothing False)
-                     , ("layout", switchLayout)
-                     , ("xterm", spawn "xterm")
-                     , ("run", spawn "exe=`dmenu_path | dmenu -b` && exec $exe")
-                     , ("kill", kill)
-                     , ("refresh", refresh)
-                     , ("focus-up", focusUp)
-                     , ("focus-down", focusDown)
-                     , ("swap-up", swapUp)
-                     , ("swap-down", swapDown)
-                     , ("swap-master", swapMaster)
-                     , ("sink", withFocused sink)
-                     , ("quit-wm", io $ exitWith ExitSuccess)
-                     ]
-
-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,89 +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
-
--- | copy. Copy a window to a new workspace.
-copy :: WorkspaceId -> X ()
-copy n = windows (copy' n)
-
-copy' :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
-copy' n s = if n `tagMember` s && n /= tag (workspace (current s))
-            then maybe s go (peek s)
-            else s
-    where go w = view (tag (workspace (current s))) $ insertUp' w $ view n s
-
- 
--- |
--- /O(n)/. (Complexity due to check if element is in current stack.) Insert
--- a new element into the stack, above the currently focused element.
---
--- The new element is given focus, and is set as the master window.
--- The previously focused element is moved down.  The previously
--- 'master' element is forgotten. (Thus, 'insert' will cause a retiling).
---
--- If the element is already in the current stack, it is shifted to the
--- focus position, as if it had been removed and then added.
---
--- Semantics in Huet's paper is that insert doesn't move the cursor.
--- However, we choose to insert above, and move the focus.
-
-insertUp' :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd
-insertUp' a s = modify (Just $ Stack a [] [])
-                (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s
-
-delete' :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd
-delete' w = sink w . modify Nothing (filter (/= w))
-
--- | 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

Decoration.hs

@@ -1,74 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Decoration
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module to be used to easily define decorations.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Decoration (
-                                 -- * Usage
-                                 -- $usage 
-                                 newDecoration 
-                                ) where
-
-import Data.Bits ( (.|.) )
-import Control.Monad.Reader ( asks )
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )
-
-import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo )
-
-import XMonad
-import Operations ( UnDoLayout(UnDoLayout) )
-
--- $usage
--- You can use this module for writing other extensions.
--- See, for instance, "XMonadContrib.Tabbed"
-
-newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
-              -> (Display -> Window -> GC -> FontStruct -> X ())
-              -> X () -> Layout a -> X (Layout a)
-newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do
-    d <- asks display
-    rt <- asks theRoot
-    win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
-    io $ selectInput d win $ exposureMask .|. buttonPressMask
-    io $ mapWindow d win
-    io $ restackWindows d $ decfor : [win]
-
-    let hook :: SomeMessage -> X (Maybe (ModLay a))
-        hook sm  | Just e <- fromMessage sm           = handle_event e >> return Nothing
-                 | Just UnDoLayout == fromMessage sm  = io (destroyWindow d win) >> return (Just id)
-                 | otherwise                          = return Nothing
-
-        handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t})
-            | t == buttonPress && thisw == win        = click
-        handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t})
-            | t == buttonPress && thisw == win        = click
-        handle_event (AnyEvent {ev_window = thisw, ev_event_type = t})
-            | thisw == win    && t == expose          = withGC win fn draw
-            | thisw == decfor && t == propertyNotify  = withGC win fn draw
-        handle_event _ = return ()
-
-    return $ layoutModify idModDo hook l
-
--- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
-withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
-withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
-                                       let fontname = if fn == "" 
-                                                      then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                                      else fn
-                                       font <- io $ catch (loadQueryFont d fontname)
-                                                          (const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*")
-                                       io $ setFont d gc (fontFromFontStruct font)
-                                       f d w gc font
-                                       io $ freeGC d gc
-                                       io $ freeFont d font

DragPane.hs

@@ -1,119 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DragPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
---                    David Roundy <droundy@darcs.net>,
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
-
--- Layouts that splits the screen either horizontally or vertically and
--- shows two windows.  The first window is always the master window, and
--- the other is either the currently focused window or the second window in
--- layout order.
-
------------------------------------------------------------------------------
-
-module XMonadContrib.DragPane (
-                               -- * Usage
-                               -- $usage
-                               dragPane, dragUpDownPane
-                              ) where
-
-import Control.Monad.Reader ( asks )
-import Graphics.X11.Xlib ( Rectangle( Rectangle ) )
-import XMonad
-import XMonadContrib.Decoration ( newDecoration )
-import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage )
-import StackSet ( focus, up, down)
-
--- $usage
---
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.DragPane
---
---  and add, to the list of layouts:
---
--- > dragPane "" (fromRational delta) (fromRational delta)
-
-halfHandleWidth :: Integral a => a
-halfHandleWidth = 2
-
-handleColor :: String
-handleColor = "#000000"
-
-dragPane :: String -> Double -> Double -> Layout a
-dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
- where
-    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
-                   root <- asks theRoot
-                   let (left', right') = splitHorizontallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ w _ -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h
-                       right = case right' of
-                               Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
-                       handr = case left' of
-                               Rectangle x y w h ->
-                                 Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
-                       wrs = case reverse (up s) of
-                             (master:_) -> [(master,left),(focus s,right)]
-                             [] -> case down s of
-                                   (next:_) -> [(focus s,left),(next,right)]
-                                   [] -> [(focus s, r)]
-                       handle = newDecoration root handr 0 handlec handlec
-                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\ex _ ->
-                                        sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
-                                        (return ())
-                                        
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split)
-                                            else return Nothing
-                   return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta))
-              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragPane ident delta frac)
-    message _ = Nothing
-
-dragUpDownPane :: String -> Double -> Double -> Layout a
-dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
- where
-    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
-                   root <- asks theRoot
-                   let (left', right') = splitVerticallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ _ w -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth)
-                       right = case right' of
-                               Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth)
-                       handr = case left' of
-                               Rectangle x y w h ->
-                                 Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth)
-                       wrs = case reverse (up s) of
-                             (master:_) -> [(master,left),(focus s,right)]
-                             [] -> case down s of
-                                   (next:_) -> [(focus s,left),(next,right)]
-                                   [] -> [(focus s, r)]
-                       handle = newDecoration root handr 0 handlec handlec
-                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\_ ey ->
-                                        sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt)))
-                                        (return ())
-                                        
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split)
-                                            else return Nothing
-                   return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta))
-              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragUpDownPane ident delta frac)
-    message _ = Nothing
-
-data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable )
-instance Message SetFrac

DwmPromote.hs

@@ -1,46 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DwmPromote
--- Copyright   :  (c) Miikka Koskinen 2007
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  arcatan@kapsi.fi
--- Stability   :  unstable
--- 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 (
-                                 -- * Usage
-                                 -- $usage 
-                                 dwmpromote
-                                ) where
-
-import XMonad
-import Operations (windows)
-import StackSet
-
--- $usage
---
--- To use, modify your Config.hs to:
---
--- >    import XMonadContrib.DwmPromote
---
--- and add a keybinding or substitute promote with dwmpromote:
---
--- >   , ((modMask,               xK_Return), dwmpromote)
-
-dwmpromote :: X ()
-dwmpromote = windows swap
-
-swap :: StackSet i a s sd -> StackSet i a s sd
-swap = modify' $ \c -> case c of
-    Stack _ [] []     -> c
-    Stack t [] (x:rs) -> Stack x [] (t:rs)
-    Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls

DynamicLog.hs

@@ -1,89 +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, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama
-  ) where
-
--- 
--- Useful imports
---
-import XMonad
-import Data.Maybe ( isJust )
-import Data.List
-import Data.Ord ( comparing )
-import qualified StackSet as S
-
--- $usage 
---
--- To use, set:
---
--- >    import XMonadContrib.DynamicLog
--- >    logHook = dynamicLog
-
-
--- |
--- Perform an arbitrary action on each state change.
--- Examples include:
---      * do nothing
---      * log the state to stdout
---
--- An example logger, print a status bar output to dzen, in the form:
---
--- > 1 2 [3] 4 7
---  
-
-dynamicLog :: X ()
-dynamicLog = withWindowSet $ io . putStrLn . pprWindowSet
-
-pprWindowSet :: WindowSet -> String
-pprWindowSet s =  concatMap fmt $ sortBy (comparing S.tag)
-            (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 | S.tag w == this         = "[" ++ pprTag w ++ "]"
-               | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">"
-               | isJust (S.stack w)      = " " ++ pprTag 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 (pprTag . S.workspace)
-                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws
-        offscreen = map pprTag . filter (isJust . S.stack)
-                        . sortBy (comparing S.tag) $ S.hidden ws
-
--- util functions
-pprTag :: Integral i => S.Workspace i a -> String
-pprTag = show . (+(1::Int)) . fromIntegral . S.tag

DynamicWorkspaces.hs

@@ -1,71 +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, modify )
-
-import XMonad ( X, XState(..), Layout, trace )
-import Operations ( windows, view )
-import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..),
-                  integrate, differentiate )
-import Data.Map ( delete, insert )
-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 defaultLayouts)
--- >   , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
-
-addWorkspace :: [Layout Window] -> X ()
-addWorkspace (l:ls) = do s <- gets windowset
-                         let newtag:_ = filter (not . (`tagMember` s)) [0..]
-                         modify $ \st -> st { layouts = insert newtag (l,ls) $ layouts st }
-                         windows (addWorkspace' newtag)
-addWorkspace [] = trace "bad layouts in XMonadContrib.DynamicWorkspaces.addWorkspace\n"
-
-removeWorkspace :: X ()
-removeWorkspace = do s <- gets windowset
-                     case s of
-                       StackSet { current = Screen { workspace = torem }
-                                , hidden = (w:_) }
-                           -> do view $ tag w
-                                 modify $ \st -> st { layouts = delete (tag torem) $ layouts st }
-                                 windows (removeWorkspace' (tag torem))
-                       _ -> return ()
-
-addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd
-addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w })
-                                 , hidden = ws })
-    = s { current = scr { workspace = Workspace newtag Nothing }
-        , hidden = w:ws }
-
-removeWorkspace' :: (Eq i) => i -> StackSet i a sid sd -> StackSet i 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

HintedTile.hs

@@ -1,94 +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
---
--- > defaultLayouts = [ 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)

LayoutHelpers.hs

@@ -1,62 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHelpers
--- 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.LayoutHelpers (
-    -- * Usage
-    -- $usage
-    DoLayout, ModDo, ModMod, ModLay,
-    layoutModify,
-    l2lModDo, idModify,
-    idModDo, idModMod,
-    ) where
-
-import Graphics.X11.Xlib ( Rectangle )
-import XMonad
-import StackSet ( Stack, integrate )
-
--- $usage
--- Use LayoutHelpers to help write easy Layouts.
-
-type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
-type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
-
-type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
-type ModMod a = SomeMessage -> X (Maybe (ModLay a))
-
-type ModLay a = Layout a -> Layout a
-
-layoutModify :: ModDo a -> ModMod a -> ModLay a
-layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
-    where dl r s = do (ws, ml') <- doLayout l r s
-                      (ws', mmod') <- fdo r s ws
-                      let ml'' = case mmod' of
-                                 Just mod' -> Just $ mod' $ maybe l id ml'
-                                 Nothing -> layoutModify fdo fmod `fmap` ml'
-                      return (ws', ml'')
-          modl m = do ml' <- modifyLayout l m
-                      mmod' <- fmod m
-                      return $ case mmod' of
-                               Just mod' -> Just $ mod' $ maybe l id ml'
-                               Nothing -> layoutModify fdo fmod `fmap` ml'
-
-l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
-l2lModDo dl r s = return (dl r $ integrate s, Nothing)
-
-idModDo :: ModDo a
-idModDo _ _ wrs = return (wrs, Nothing)
-
-idModify :: ModifyLayout a
-idModify _ = return Nothing
-
-idModMod :: ModMod a
-idModMod _ = return Nothing

LayoutHints.hs

@@ -1,43 +0,0 @@
------------------------------------------------------------------------------
--- |
--- 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) 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.LayoutHelpers ( layoutModify, idModMod )
-
--- $usage
--- > import XMonadContrib.LayoutHints
--- > defaultLayouts = [ layoutHints tiled , layoutHints $ mirror tiled ]
-
--- | 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)
-
-layoutHints :: Layout Window -> Layout Window
-layoutHints = layoutModify applyHints idModMod
-    where applyHints _ _ xs = do xs' <- mapM applyHint xs
-                                 return (xs', Nothing)
-          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')

LayoutHooks.hs

@@ -1,44 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHooks
--- Copyright    : (c) Stefan O'Rear <stefanor@cox.net>
--- License      : BSD
---
--- Maintainer   : Stefan O'Rear <stefanor@cox.net>
--- Stability    : unstable
--- Portability  : portable
---
--- General layout-level hooks.
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutHooks ( addLayoutMessageHook ) where
-
-import qualified Data.Map as M  ( adjust  )
-import Control.Arrow            ( first   )
-import Control.Monad.State      ( modify  )
-
-import XMonad
-import qualified StackSet as W
-
-install :: (SomeMessage -> X Bool) -> Layout a -> Layout a
-install hk lay = lay{ modifyLayout = mod' }
-  where
-    mod' msg = do reinst  <- hk msg
-                  nlay    <- modifyLayout lay msg
-
-                  return $ cond_reinst reinst nlay
-
-    -- no need to make anything change
-    cond_reinst True   Nothing      = Nothing
-    -- reinstall
-    cond_reinst True   (Just nlay)  = Just (install hk nlay)
-    -- restore inner layout
-    cond_reinst False  Nothing      = Just lay
-    -- let it rot
-    cond_reinst False  (Just nlay)  = Just nlay
-
--- Return True each time you want the hook reinstalled
-addLayoutMessageHook     :: (SomeMessage -> X Bool) -> X ()
-addLayoutMessageHook hk  = modify $ \ s ->
-    let nr = W.tag . W.workspace . W.current . windowset $ s
-      in s { layouts = M.adjust (first $ install hk) nr (layouts s) }

MagicFocus.hs

@@ -1,33 +0,0 @@
------------------------------------------------------------------------------
--- |
--- 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) where
-
-import Graphics.X11.Xlib (Window)
-import XMonad
-import StackSet
-
--- $usage
--- > import XMonadContrib.MagicFocus
--- > defaultLayouts = [ magicFocus tiled , magicFocus $ mirror tiled ]
-
-magicFocus :: Layout Window -> Layout Window
-magicFocus l = l { doLayout = \r s -> withWindowSet (return . peek) >>= (doLayout l) r . swap s
-                 , modifyLayout = \x -> fmap magicFocus `fmap` modifyLayout l x }
-
-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,64 +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
--- > defaultLayouts = [ magnifier tiled , 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')

MetaModule.hs

@@ -1,71 +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 ()
-import XMonadContrib.CopyWindow ()
-import XMonadContrib.Decoration ()
-import XMonadContrib.DeManage ()
-import XMonadContrib.DirectoryPrompt ()
-import XMonadContrib.Dmenu ()
-import XMonadContrib.DragPane ()
-import XMonadContrib.DwmPromote ()
-import XMonadContrib.DynamicLog ()
-import XMonadContrib.DynamicWorkspaces ()
-import XMonadContrib.Dzen ()
-import XMonadContrib.FindEmptyWorkspace ()
-import XMonadContrib.FlexibleResize ()
-import XMonadContrib.FlexibleManipulate ()
-import XMonadContrib.FocusNth ()
-import XMonadContrib.HintedTile ()
-import XMonadContrib.LayoutHelpers ()
-import XMonadContrib.LayoutHints ()
-import XMonadContrib.LayoutHooks ()
-import XMonadContrib.LayoutScreens ()
-import XMonadContrib.MagicFocus ()
-import XMonadContrib.Magnifier ()
-import XMonadContrib.Mosaic ()
-import XMonadContrib.NamedWindows ()
-import XMonadContrib.NoBorders ()
-import XMonadContrib.Roledex ()
-import XMonadContrib.RotSlaves ()
-import XMonadContrib.RotView ()
--- XMonadContrib.ShellPrompt depends on readline
---import XMonadContrib.ShellPrompt ()
-import XMonadContrib.SimpleDate ()
-import XMonadContrib.SimpleStacking ()
-import XMonadContrib.SinkAll ()
-import XMonadContrib.Spiral ()
-import XMonadContrib.Square ()
-import XMonadContrib.SshPrompt ()
-import XMonadContrib.Submap ()
-import XMonadContrib.SwitchTrans ()
-import XMonadContrib.Tabbed ()
-import XMonadContrib.ThreeColumns ()
-import XMonadContrib.TwoPane ()
-import XMonadContrib.ViewPrev ()
-import XMonadContrib.XMonadPrompt ()
-import XMonadContrib.XPrompt ()
-import XMonadContrib.Warp ()
-import XMonadContrib.WorkspaceDir ()

NoBorders.hs

@@ -1,57 +0,0 @@
------------------------------------------------------------------------------
--- |
--- 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, 
-                                withBorder 
-                               ) where
-
-import Control.Monad.State ( gets )
-import Graphics.X11.Xlib
-
-import XMonad
-import Operations ( UnDoLayout(UnDoLayout) )
-import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.NoBorders
---
--- and modify the defaultLayouts to call noBorders on the layouts you want to lack
--- borders
---
--- > defaultLayouts = [ noBorders full, ... ]
-
-noBorders :: Layout a -> Layout a
-noBorders = withBorder 0
-
-withBorder :: Dimension -> Layout a -> Layout a
-withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x
-                    , modifyLayout = ml }
-    where ml m | Just UnDoLayout == fromMessage m
-                   = do setborders borderWidth
-                        fmap (withBorder bd) `fmap` (modifyLayout l) m
-               | otherwise = fmap (withBorder bd) `fmap` (modifyLayout l) m
-
-setborders :: Dimension -> X ()
-setborders bw = withDisplay $ \d ->
-                do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
-                   mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws

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,46 +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 usefull together with the TwoPane-Layout (see XMonadContrib.TwoPane).
-
-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,45 +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 )
-import Data.Maybe ( listToMaybe, isJust )
-import Data.Ord ( comparing )
-
-import XMonad
-import StackSet hiding (filter)
-import qualified Operations as O
-
--- $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)
-
-rotView :: Bool -> X ()
-rotView b = do
-    ws <- gets windowset
-    let m = tag . workspace . current $ ws
-        sortWs = sortBy (comparing tag)
-        pivoted = uncurry (flip (++)) . span ((< m) . tag) . sortWs . hidden $ ws
-        nextws = listToMaybe . filter (isJust . stack) . (if b then id else reverse) $ pivoted
-    whenJust nextws (O.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,91 +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
-                             , rmPath
-                             , split
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-
-import Control.Monad
-import Data.List
-import System.Console.Readline
-import System.Environment
-
--- $usage
---
--- 1. In xmonad.cabal change: 
---
--- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0
---
--- to
---
--- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0
---
--- 2. In Config.hs add:
---
--- > import XMonadContrib.XPrompt
--- > import XMonadContrib.ShellPrompt
---
--- 3. In your keybindings add something like:
---
--- >   , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
---
-
-data Shell = Shell
-
-instance XPrompt Shell where
-    showXPrompt Shell = "Run:   "
-
-
-shellPrompt :: XPConfig -> X ()
-shellPrompt c = mkXPrompt Shell c getShellCompl spawn
-
-getShellCompl :: String -> IO [String]
-getShellCompl s 
-    | s /= "" && last s /= ' ' = do
-  fl <- filenameCompletionFunction s
-  c <- commandCompletionFunction s
-  return $ sort . nub $ fl ++ c
-    | otherwise = return []
-
-commandCompletionFunction :: String -> IO [String]
-commandCompletionFunction str 
-    | '/' `elem` str = return []
-    | otherwise = do
-  p <- getEnv "PATH"
-  cl p
-    where
-      cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':'  
-      addToPath = flip (++) ("/" ++ str)
-      fCF = filenameCompletionFunction
-
-rmPath :: [String] -> [String]
-rmPath s = 
-    map (reverse . fst . break  (=='/') . reverse) s
-
-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
-

SimpleStacking.hs

@@ -1,44 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SimpleStacking
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module to be used to obtain a simple "memory" of stacking order.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.SimpleStacking (
-                                     -- * Usage
-                                     -- $usage 
-                                     simpleStacking
-                                    ) where
-
-import Data.Maybe ( catMaybes )
-
-import Data.List ( nub, lookup )
-import StackSet ( focus, up, down )
-import Graphics.X11.Xlib ( Window )
-
-import XMonad
-import XMonadContrib.LayoutHelpers
-
--- $usage
--- You can use this module for 
--- See, for instance, "XMonadContrib.Tabbed"
-
-simpleStacking :: Layout Window -> Layout Window
-simpleStacking = simpleStacking' []
-
-simpleStacking' :: [Window] -> Layout Window -> Layout Window
-simpleStacking' st = layoutModify dl idModMod
-    where dl _ s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs
-                           wrs' = catMaybes $ map ((flip lookup) m) $
-                                  nub (focus s : st ++ map fst wrs)
-                           st' = focus s:filter (`elem` (up s++down s)) st
-                       in return (wrs', Just (simpleStacking' st'))

SinkAll.hs

@@ -1,34 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XmonadContrib.SinkAll
--- License      : BSD3-style (see LICENSE)
--- Stability    : unstable
--- Portability  : unportable
---
--- Provides a simple binding that pushes all floating windows on the current
--- workspace back into tiling.
------------------------------------------------------------------------------
-
-module XMonadContrib.SinkAll (
-    -- * Usage
-    -- $usage
-    sinkAll) where
-
-import Operations
-import XMonad
-import StackSet hiding (sink)
-
-import Control.Monad.State
-import Graphics.X11.Xlib
-
--- $usage
--- > import XMonadContrib.SinkAll
--- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ]
-
-sinkAll :: X ()
-sinkAll = withAll sink
-
--- Apply a function to all windows on current workspace.
-withAll :: (Window -> X a) -> X ()
-withAll f = gets (integrate' . stack . workspace . current . windowset) >>=
-    mapM_ f

SshPrompt.hs

@@ -1,60 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SshPrompt
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
--- 
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A ssh prompt for XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.SshPrompt (
-                             -- * Usage
-                             -- $usage
-                             sshPrompt
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-import XMonadContrib.RunInXTerm
-
-import Control.Monad
-import System.Directory
-import System.Environment
-
--- $usage
--- 1. In Config.hs add:
---
--- > import XMonadContrib.XPrompt
--- > import XMonadContrib.SshPrompt
---
--- 3. In your keybindings add something like:
---
--- >   , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig)
---
-
-data Ssh = Ssh
-
-instance XPrompt Ssh where
-    showXPrompt Ssh = "SSH to:   "
-
-sshPrompt :: XPConfig -> X ()
-sshPrompt c = do
-  sc <- io $ sshComplList
-  mkXPrompt Ssh c (mkComplFunFromList sc) ssh
-
-ssh :: String -> X ()
-ssh s = runInXTerm ("ssh " ++ s)
- 
-sshComplList :: IO [String]
-sshComplList = do
-  h <- getEnv "HOME"
-  let kh = h ++ "/.ssh/known_hosts"
-  f <- doesFileExist kh
-  if f then do l <- readFile kh
-               return $ map (takeWhile (/= ',') . concat . take 1 . words) (lines l)
-       else return []

SwitchTrans.hs

@@ -1,161 +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.
---
--- Here's how you might use this in Config.hs:
---
--- > defaultLayouts =
--- >     map (
--- >         mkSwitch (M.singleton "full" (const $ noBorders full)) .
--- >         mkSwitch (M.singleton "mirror" mirror)
--- >     ) [ 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 $ noBorders full), ("mirror", 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)
-
--- | 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 State a = State {
-    base :: Layout a,
-    currTag :: Maybe String,
-    currLayout :: Layout a,
-    currFilt :: Layout a -> Layout a,
-    filters :: Map String (Layout a -> Layout a)
-}
-
--- | 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 = switched st
-    where
-    st = State{
-        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
-
-switched :: State a -> Layout a
-switched
-    state@State{
-        base = b,
-        currTag = ct,
-        currLayout = cl,
-        currFilt = cf,
-        filters = fs
-    } = Layout {doLayout = dl, modifyLayout = ml}
-    where
-    enable tag alt = do
-        modifyLayout cl (SomeMessage UnDoLayout)
-        return . Just . switched $ state{
-            currTag = Just tag,
-            currFilt = alt,
-            currLayout = alt b }
-    disable = do
-        modifyLayout cl (SomeMessage UnDoLayout)
-        return . Just . switched $ state{
-            currTag = Nothing,
-            currFilt = id,
-            currLayout = b }
-    dl r s = do
-        (x, _) <- doLayout cl r s
-        return (x, Nothing)  -- sorry Dave, I can't let you do that
-    ml m
-        | Just (Disable tag) <- fromMessage m
-        , M.member tag fs
-        = provided (ct == Just tag) $ disable
-        | Just (Enable tag) <- fromMessage m
-        , Just alt <- M.lookup tag fs
-        = provided (ct /= Just tag) $ enable tag alt
-        | Just (Toggle tag) <- fromMessage m
-        , Just alt <- M.lookup tag fs
-        =
-            if (ct == Just tag) then
-                disable
-            else
-                enable tag alt
-        | Just UnDoLayout <- fromMessage m
-        = do
-            modifyLayout cl m
-            return Nothing
-        | otherwise = do
-            x <- modifyLayout b m
-            case x of
-                Nothing -> return Nothing
-                Just b' -> do
-                    modifyLayout cl (SomeMessage UnDoLayout)
-                    return . Just $ switched state{
-                        base = b',
-                        currLayout = cf b' }

Tabbed.hs

@@ -1,143 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Tabbed
--- Copyright   :  (c) David Roundy
--- License     :  BSD-style (see xmonad/LICENSE)
--- 
--- Maintainer  :  email@address.com
--- Stability   :  unstable
--- Portability :  unportable
---
--- A tabbed layout for the Xmonad Window Manager 
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Tabbed ( 
-                             -- * Usage:
-                             -- $usage
-                              tabbed
-                            , Shrinker, shrinkText
-                            , TConf (..), defaultTConf
-                            ) where
-
-import Control.Monad.State ( gets )
-
-import Graphics.X11.Xlib
-import XMonad
-import XMonadContrib.Decoration
-import Operations ( focus, initColor )
-import qualified StackSet as W
-
-import XMonadContrib.NamedWindows
-import XMonadContrib.SimpleStacking ( simpleStacking )
-import XMonadContrib.LayoutHelpers ( idModify )
-
--- $usage
--- You can use this module with the following in your configuration file:
---
--- > import XMonadContrib.Tabbed
---
--- > defaultLayouts :: [Layout Window]
--- > defaultLayouts = [ tabbed shrinkText defaultTConf
--- >                  , ... ]
---
--- You can also edit the default configuration options.
---
--- > myconfig = defaultTConf { inactiveBolderColor = "#FF0000"
--- >                         , activeTextColor = "#00FF00"}
---
--- and
---
--- > defaultLayouts = [ tabbed shrinkText myconfig
--- >                  , ... ]
-
-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
-          }
-
-tabbed :: Shrinker -> TConf -> Layout Window
-tabbed s t = simpleStacking $ tabbed' s t
-
-tabbed' :: Shrinker -> TConf -> Layout Window
-tabbed' shrinkT config =  Layout { doLayout = dolay shrinkT config, modifyLayout = idModify }
-
-dolay :: Shrinker -> TConf
-      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window))
-dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing)
-dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
-    do ac   <- io $ initColor dpy $ activeColor conf
-       ic <- io $ initColor dpy $ inactiveColor conf
-       abc <- io $ initColor dpy $ activeBorderColor conf
-       ibc <- io $ initColor dpy $ inactiveBorderColor conf
-       atc <- io $ initColor dpy $ activeTextColor conf 
-       itc <- io $ initColor dpy $ inactiveTextColor conf
-       let ws = W.integrate s
-           ts = gentabs conf x y wid (length ws)
-           tws = zip ts ws
-           focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w 
-                                                                then actcol else incol) . W.peek) 
-                                       `fmap` gets windowset
-           make_tabs [] l = return l
-           make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc
-                                       l' <- maketab tw' bc l
-                                       make_tabs tws' l'
-           maketab (t,ow) bg = newDecoration ow t 1 bg ac
-                                (fontName conf) (drawtab t ow) (focus ow)
-           drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn =
-               do nw <- getName ow
-                  (fc,tc) <- focusColor ow (ic,itc) (ac,atc)
-                  io $ setForeground d gc fc
-                  io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
-                  io $ setForeground d gc tc
-                  centerText d w' gc fn r (show nw)
-           centerText d w' gc fontst (Rectangle _ _ wt ht) name =
-               do let (_,asc,_,_) = textExtents fontst name
-                      name' = shrinkWhile shr (\n -> textWidth fontst n >
-                                                     fromIntegral wt - fromIntegral (ht `div` 2)) name
-                      width = textWidth fontst name'
-                  io $ drawString d w' gc
-                         (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
-                         ((fromIntegral ht + fromIntegral asc) `div` 2) name'
-       l' <- make_tabs tws $ tabbed shr conf
-       return (map (\w -> (w,shrink conf sc)) ws, Just l')
-
-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)
-
-shrink :: TConf -> Rectangle -> Rectangle
-shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
-
-gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle]
-gentabs _ _ _ _ 0 = []
-gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2)
-                      : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1)
-                          where wid = w `div` (fromIntegral num)

TwoPane.hs

@@ -1,50 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.TwoPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout that splits the screen horizontally and shows two windows.  The
--- left window is always the master window, and the right is either the
--- currently focused window or the second window in layout order.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.TwoPane (
-                              -- * Usage
-                              -- $usage
-                              twoPane
-                             ) where
-
-import XMonad
-import Operations ( Resize(..), splitHorizontallyBy )
-import StackSet ( focus, up, down)
-
--- $usage
---
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.TwoPane
---
---  and add, to the list of layouts:
---
--- > twoPane defaultDelta (1%2)
-
-twoPane :: Rational -> Rational -> Layout a
-twoPane delta split = Layout { doLayout = \r s -> return (arrange r s,Nothing), modifyLayout = message }
- where
-    arrange rect st = case reverse (up st) of
-                        (master:_) -> [(master,left),(focus st,right)]
-                        [] -> case down st of
-                                (next:_) -> [(focus st,left),(next,right)]
-                                [] -> [(focus st, rect)]
-        where (left, right) = splitHorizontallyBy split rect
-
-    message x = return $ case fromMessage x of
-                    Just Shrink -> Just (twoPane delta (split - delta))
-                    Just Expand -> Just (twoPane delta (split + delta))
-                    _           -> Nothing

ViewPrev.hs

@@ -1,28 +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' :: (Eq a, Eq s, Eq i) => W.StackSet i a s sd -> W.StackSet i a s sd
-viewPrev' x = W.view (W.tag . head . W.hidden $ x) x
-
-viewPrev :: X ()
-viewPrev = windows viewPrev'

WorkspaceDir.hs

@@ -1,64 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- 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 exstension 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.
---
------------------------------------------------------------------------------
-
-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.LayoutHelpers ( layoutModify )
-import XMonadContrib.XPrompt ( defaultXPConfig )
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.WorkspaceDir
--- >
--- > defaultLayouts = map (workspaceDir "~") [ tiled, ... ]
---
--- In keybindings:
---
--- >  , ((modMask .|. shiftMask, xK_x     ), changeDir defaultXPConfig)
-
-
-data Chdir = Chdir String deriving ( Typeable )
-instance Message Chdir
-
-workspaceDir :: String -> Layout a -> Layout a
-workspaceDir wd = layoutModify dowd modwd
-    where dowd _ _ rws = scd wd >> return (rws, Nothing)
-          modwd m = return $ do Chdir wd' <- fromMessage m
-                                Just $ workspaceDir wd'
-
-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), runCommand commands)
+--
+-- and define the list of commands you want to use:
+--
+-- >    commands :: [(String, X ())]
+-- >    commands = defaultCommands
+--
+-- Whatever key you bound to will now cause a popup menu of internal
+-- xmonad commands to appear.  You can change the commands by
+-- changing the contents of the list 'commands'.  (If you like it
+-- 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/CycleWS.hs

@@ -0,0 +1,134 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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, and to move windows there, and to cycle between the screens.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleWS (
+                              -- * Usage
+                              -- $usage
+                              nextWS,
+                              prevWS,
+                              shiftToNext,
+                              shiftToPrev,
+                              toggleWS,
+                              nextScreen,
+                              prevScreen,
+                              shiftNextScreen,
+                              shiftPrevScreen
+                             ) where
+
+import Data.List ( findIndex )
+import Data.Maybe ( fromMaybe )
+
+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
+--
+-- >   , ((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_t),     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)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+-- | 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)
+
+-- | 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 d = do
+    ws <- gets windowset
+    sort' <- getSortByTag
+    let orderedWs = sort' (workspaces ws)
+    let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs
+    let next = orderedWs !! ((now + d) `mod` length orderedWs)
+    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))
+
+-- | 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,7 +1,6 @@
-{-# OPTIONS -fglasgow-exts #-}
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.DeManage
+-- Module      :  XMonad.Actions.DeManage
 -- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -9,46 +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".
 
--- | 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

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DwmPromote
+-- Copyright   :  (c) Miikka Koskinen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  arcatan@kapsi.fi
+-- Stability   :  unstable
+-- 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 XMonad.Actions.DwmPromote (
+                                 -- * Usage
+                                 -- $usage
+                                 dwmpromote
+                                ) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.DwmPromote
+--
+-- then add a keybinding or substitute 'dwmpromote' in place of promote:
+--
+-- >   , ((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
+                   Stack _ [] []     -> c
+                   Stack t [] (x:rs) -> Stack x [] (t:rs)
+                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls

XMonad/Actions/DynamicWorkspaces.hs

@@ -0,0 +1,127 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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 Data.List ( sort )
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet hiding (filter, modify, delete)
+import XMonad.Prompt.Workspace
+import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+
+-- $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)
+                         let ts = sort $ map tag 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 ws <- gets (sort . map tag . workspaces . windowset)
+                             case drop wnum ws of
+                               (w:_) -> job w
+                               [] -> return ()
+
+withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
+withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)
+                               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,45 +8,44 @@
 -- 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 qualified Operations as O
+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.
-
+--  >   , ((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
 -- focused workspace, other visible workspaces (when in Xinerama) and
 -- hidden workspaces in this order.
-findEmptyWorkspace :: StackSet i a s sd -> Maybe (Workspace i a)
+findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a)
 findEmptyWorkspace = find (isNothing . stack) . allWorkspaces
   where
     allWorkspaces ss = (workspace . current) ss :
@@ -60,9 +59,9 @@ withEmptyWorkspace f = do
 -- | Find and view an empty workspace. Do nothing if all workspaces are
 -- in use.
 viewEmptyWorkspace :: X ()
-viewEmptyWorkspace = withEmptyWorkspace O.view
+viewEmptyWorkspace = withEmptyWorkspace (windows . view)
 
 -- | Tag current window to an empty workspace and view it. Do nothing if
 -- all workspaces are in use.
 tagToEmptyWorkspace :: X ()
-tagToEmptyWorkspace = withEmptyWorkspace $ \w -> O.shift w >> O.view w
+tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w

XMonad/Actions/FlexibleManipulate.hs

@@ -1,64 +1,80 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
--- 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 builtin 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.
+-- 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
@@ -76,13 +92,13 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
             npos = wpos + offset * atl
             nbr = (wpos + wsize) + offset * abr
             ntl = minP (nbr - (32, 32)) npos    --minimum size
-            nwidth = applySizeHints sh $ mapP round (nbr - ntl)
+            nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)
         moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
         return ())
         (float w)
 
     float w
-    
+
   where
     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
     winAttrs :: WindowAttributes -> [Pnt]
@@ -99,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,37 +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 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
@@ -57,8 +60,8 @@ mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
     firstHalf a b = fromIntegral a * 2 <= b
     cfst = curry fst
     csnd = curry snd
-    mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Dimension)
+    mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position)
     mkSel b k p =
         if b
-            then (0, csnd, fromIntegral . max 1 . ((k + p) -) . fromIntegral)
-            else (k, cfst, fromIntegral . max 1 . subtract p  . fromIntegral)
+            then (0, csnd, ((k + p) -) . fromIntegral)
+            else (k, cfst, subtract p  . fromIntegral)

XMonad/Actions/FloatKeys.hs

@@ -0,0 +1,121 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.FloatKeys
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Move and resize floating windows.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FloatKeys (
+                -- * Usage
+                -- $usage
+                keysMoveWindow,
+                keysMoveWindowTo,
+                keysResizeWindow,
+                keysAbsResizeWindow) where
+
+import XMonad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.FloatKeys
+--
+-- Then add appropriate key bindings, for example:
+--
+-- >  , ((modMask x,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
+-- >  , ((modMask x,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
+-- >  , ((modMask x .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
+-- >  , ((modMask x .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
+-- >  , ((modMask x,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
+--
+-- 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
+    wa <- io $ getWindowAttributes d w
+    io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))
+                        (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
+    wa <- io $ getWindowAttributes d w
+    io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))
+                        (y - round (gy * fromIntegral (wa_height wa)))
+    float w
+
+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'
+
+keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
+keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
+    where
+        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        nx :: Rational
+        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
+        ny :: Rational
+        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
+
+keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
+keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
+    where
+        (nw, nh) = applySizeHints sh (w + dx, h + dy)
+        nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
+        ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
+
+keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    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
+    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,35 +8,43 @@
 -- Stability    : unstable
 -- Portability  : unportable
 --
--- Focus the n'th 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".
 
+-- | 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,125 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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(..),
+    mouseGesture
+) where
+
+import XMonad
+
+import Data.IORef
+import qualified Data.Map as M
+import Data.Map (Map)
+import Control.Monad
+
+import System.IO
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Commands
+-- > import 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".
+
+-- | The four cardinal screen directions. A \"gesture\" is a sequence of
+--   directions.
+data Direction = L | U | R | D
+    deriving (Eq, Ord, Show, Read, Enum, Bounded)
+
+type Pos = (Position, Position)
+
+delta :: Pos -> Pos -> Position
+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
+
+-- | Given a 'Data.Map.Map' from lists of directions to actions with
+--   windows, figure out which one the user is performing, and return
+--   the corresponding action.
+mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()
+mouseGesture tbl win = withDisplay $ \dpy -> do
+    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'

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

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

XMonad/Actions/Search.hs

@@ -0,0 +1,138 @@
+{- |
+ 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
+ <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
+
+ Additional sites welcomed.
+-}
+module XMonad.Actions.Search (      -- * Usage
+                                 -- $usage
+                                 search,
+                                 simpleEngine,
+                                 promptSearch,
+                                 selectSearch,
+
+                                 amazon,
+                                 google,
+                                 imdb,
+                                 wayback,
+                                 wikipedia,
+                                 hoogle
+                          ) 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'.
+-}
+
+-- 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 SearchEngine = String -> String
+
+search :: MonadIO m => Browser -> SearchEngine -> String -> 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 :: String -> SearchEngine
+simpleEngine site query = site ++ escape query
+
+-- The engines
+amazon, google, hoogle, imdb, 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="
+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,24 +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
+-- 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

@@ -0,0 +1,40 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.SinkAll
+-- License      : BSD3-style (see LICENSE)
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides a simple binding that pushes all floating windows on the current
+-- workspace back into tiling.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SinkAll (
+    -- * Usage
+    -- $usage
+    sinkAll) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+--
+-- 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.
+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,62 +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".
+
 -}
 
+-- | 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

@@ -0,0 +1,54 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.SwapWorkspaces
+-- Copyright   :  (c) Devin Mullins <me@twifkak.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Lets you swap workspace tags, so you can keep related ones next to
+-- each other, without having to move individual windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SwapWorkspaces (
+                                     -- * Usage
+                                     -- $usage
+                                     swapWithCurrent,
+                                     swapWorkspaces
+                                    ) where
+
+import XMonad.StackSet
+
+
+-- $usage
+-- Add this import to your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.SwapWorkspaces
+--
+-- Then throw something like this in your keys definition:
+--
+-- > ++
+-- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5
+-- 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 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
+    where swap w = if      tag w == t1 then w { tag = t2 }
+                   else if tag w == t2 then w { tag = t1 }
+                   else w

XMonad/Actions/TagWindows.hs

@@ -0,0 +1,201 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.TagWindows
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Functions for tagging windows and selecting them by tags.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.TagWindows (
+                 -- * Usage
+                 -- $usage
+                 addTag, delTag, unTag,
+                 setTags, getTags, hasTag,
+                 withTaggedP,  withTaggedGlobalP, withFocusedP,
+                 withTagged ,  withTaggedGlobal ,
+                 focusUpTagged,   focusUpTaggedGlobal,
+                 focusDownTagged, focusDownTaggedGlobal,
+                 shiftHere, shiftToScreen,
+                 tagPrompt,
+                 tagDelPrompt
+                 ) where
+
+import Data.List (nub,concat,sortBy)
+import Control.Monad
+
+import XMonad.StackSet hiding (filter)
+
+import XMonad.Prompt
+import XMonad hiding (workspaces)
+
+-- $usage
+--
+-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.TagWindows
+-- > import XMonad.Prompt    -- to use tagPrompt
+--
+-- 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".
+
+-- | 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
+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
+getTags :: Window -> X [String]
+getTags w = withDisplay $ \d ->
+    io $ catch (internAtom d "_XMONAD_TAGS" False >>=
+                getTextProperty d w >>=
+                wcTextPropertyToTextList d)
+               (\_ -> return [[]])
+    >>= return . words . unwords
+
+-- | check a window for the given tag
+hasTag :: String -> Window -> X Bool
+hasTag s w = (s `elem`) `fmap` getTags w
+
+-- | 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
+delTag :: String -> Window -> X ()
+delTag s w = do
+    tags <- getTags w
+    setTags (filter (/= s) tags) w
+
+-- | 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
+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
+        (crs, cls) = (cms down, cms (reverse . up))
+        cms f = maybe [] f (stack . workspace . current $ ws)
+
+wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
+wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])
+    where
+        curtag = tag . workspace . current $ ws
+        (crs, cls) = (cms down, cms (reverse . up))
+        cms f = maybe [] f (stack . workspace . current $ ws)
+        (lws, rws) = (mws (<), mws (>))
+        mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws
+        sortByTag = sortBy (\x y -> compare (tag x) (tag y))
+
+focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
+focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
+    maybe (return ()) (windows . focusWindow)
+
+findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+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
+withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
+withTaggedP       t f = withTagged'       t (winMap f)
+withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)
+
+winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
+winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw))
+
+withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()
+withTagged       t f = withTagged'       t (mapM_ f)
+withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)
+
+withTagged' :: String -> ([Window] -> X ()) -> X ()
+withTagged' t m = gets windowset >>=
+    filterM (hasTag t) . integrate' . stack . workspace . current >>= m
+
+withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
+withTaggedGlobal' t m = gets windowset >>=
+    filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
+
+withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
+withFocusedP f = withFocused $ windows . f
+
+shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftHere w s = shiftWin (tag . workspace . current $ s) w s
+
+shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
+                                []      -> s
+                                (t:_)   -> shiftWin (tag . workspace $ t) w s
+
+data TagPrompt = TagPrompt
+
+instance XPrompt TagPrompt where
+    showXPrompt TagPrompt = "Select Tag:   "
+
+
+tagPrompt :: XPConfig -> (String -> X ()) -> X ()
+tagPrompt c f = do
+  sc <- tagComplList
+  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
+
+tagComplList :: X [String]
+tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
+    mapM getTags >>=
+    return . nub . concat
+
+
+tagDelPrompt :: XPConfig -> X ()
+tagDelPrompt c = do
+  sc <- tagDelComplList
+  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/Warp.hs

@@ -1,59 +1,65 @@
 -----------------------------------------------------------------------------
 -- |
--- 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.Maybe
 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
+
 -}
 
+-- 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)
 
-ix :: Int -> [a] -> Maybe a
-ix n = listToMaybe . take 1 . drop n
-
 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 ->
@@ -61,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

@@ -0,0 +1,81 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WindowBringer
+-- Copyright   :  Devin Mullins <me@twifkak.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- dmenu operations to bring windows to you, and bring you to windows.
+-- That is to say, it pops up a dmenu with window names, in case you forgot
+-- where you left your XChat.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.WindowBringer (
+                                    -- * Usage
+                                    -- $usage
+                                    gotoMenu, bringMenu, windowMapWith
+                                   ) where
+
+import Data.Char (toLower)
+import qualified Data.Map as M
+
+import qualified XMonad.StackSet as W
+import XMonad
+import qualified XMonad as X
+import XMonad.Util.Dmenu (dmenuMap)
+import XMonad.Util.NamedWindows (getName)
+
+-- $usage
+--
+-- Import the module into your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.WindowBringer
+--
+-- and define appropriate key bindings:
+--
+-- > , ((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".
+
+
+-- | Pops open a dmenu with window titles. Choose one, and you will be
+--   taken to the corresponding workspace.
+gotoMenu :: X ()
+gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView)
+ where workspaceMap = windowMapWith (W.tag . fst)
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   dragged, kicking and screaming, into your current workspace.
+bringMenu :: X ()
+bringMenu = windowMap >>= actionMenu (windows . bringWindow)
+ where windowMap = windowMapWith snd
+       bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws
+
+-- | Calls dmenuMap to grab the appropriate element from the Map, and hands it
+--   off to action if found.
+actionMenu :: (a -> X ()) -> M.Map String a -> X ()
+actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action
+
+-- | 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
+  M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
+ where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
+       keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w
+
+-- | Returns the window name as will be listed in dmenu.
+--   Lowercased, for your convenience (since dmenu is case-sensitive).
+--   Tagged with the workspace ID, to guarantee uniqueness, and to let the user
+--   know where he's going.
+decorateName :: X.WindowSpace -> Window -> X String
+decorateName ws w = do
+  name <- fmap (map toLower . show) $ getName w
+  return $ name ++ " [" ++ W.tag ws ++ "]"

XMonad/Actions/WmiiActions.hs

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

XMonad/Config/Arossato.hs

@@ -0,0 +1,163 @@
+{-# 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
+    , arossatoTabbedConfig
+    ) where
+
+import qualified Data.Map as M
+
+import XMonad
+import XMonad.ManageHook
+import qualified XMonad.StackSet as W
+
+import XMonad.Actions.CycleWS
+import XMonad.Hooks.DynamicLog
+import XMonad.Layout.Accordion
+import XMonad.Layout.Magnifier
+import XMonad.Layout.NoBorders
+import XMonad.Layout.Tabbed
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+import XMonad.Prompt.Ssh
+import XMonad.Prompt.Window
+import XMonad.Prompt.XMonad
+
+-- $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
+--
+--
+-- 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
+-- >     , arossatoTabbedConfig
+-- >     ) where
+--
+-- to
+--
+-- > module Main where
+--
+-- 2. Add a line like:
+--
+-- > main = xmonad arossatoConfig
+--
+-- 3. Start playing with the configuration options...;)
+
+-- | My configuration for the Tabbed Layout. Basically this is the
+-- Ion3 clean style.
+arossatoTabbedConfig :: TConf
+arossatoTabbedConfig =
+    defaultTConf { activeColor         = "#8a999e"
+                 , inactiveColor       = "#545d75"
+                 , activeBorderColor   = "white"
+                 , inactiveBorderColor = "grey"
+                 , activeTextColor     = "white"
+                 , inactiveTextColor   = "grey"
+                 , tabSize             = 15
+                 }
+
+arossatoConfig = defaultConfig
+         { workspaces         = ["home","var","dev","mail","web","doc"] ++
+                                map show [7 .. 9 :: Int]
+         , logHook            = dynamicLogXmobar
+         , manageHook         = newManageHook
+         , layoutHook         = noBorders mytab |||
+                                magnifier tiled |||
+                                noBorders Full  |||
+                                tiled           |||
+                                Mirror tiled    |||
+                                Accordion
+         , terminal           = "urxvt +sb"
+         , normalBorderColor  = "white"
+         , focusedBorderColor = "black"
+         , keys               = newKeys
+         , defaultGaps        = [(15,0,0,0)]
+         }
+    where
+      -- layouts
+      mytab = tabbed shrinkText arossatoTabbedConfig
+      tiled = Tall 1 (3/100) (1/2)
+
+      -- manageHook
+      myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat
+                                 , resource =? "win"          --> doF (W.shift "doc") -- xpdf
+                                 , resource =? "firefox-bin"  --> doF (W.shift "web")
+                                 ]
+      newManageHook = myManageHook <+> manageHook defaultConfig
+
+      -- 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    ), windowPromptGoto  defaultXPConfig     )
+          , ((modMask x              , xK_F6    ), 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   )
+          ] ++
+          -- 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,24 @@
+--------------------------------------------------------------------
+-- |
+-- Module    : XMonad.Config.Dons
+-- Copyright : (c) Galois, Inc. 2007
+-- License   : BSD3
+--
+-- Maintainer: Don Stewart <dons@galois.com>
+--
+-- An example, simple configuration file.
+--
+--------------------------------------------------------------------
+
+module XMonad.Config.Dons where
+
+import XMonad
+import XMonad.Hooks.DynamicLog
+
+donsMain :: IO ()
+donsMain = dzen $ \conf -> xmonad $ conf
+        { borderWidth        = 2
+        , terminal           = "term"
+        , normalBorderColor  = "#cccccc"
+        , focusedBorderColor = "#cd8b00" }
+

XMonad/Config/Droundy.hs

@@ -0,0 +1,190 @@
+{-# 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 Control.Monad.State ( modify )
+
+import XMonad hiding (keys, config, (|||))
+import qualified XMonad (keys)
+import XMonad.Config ( defaultConfig )
+
+--import XMonad.Core ( windowset )
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+import System.Exit
+
+-- % Extension-provided imports
+
+import XMonad.Layout.Tabbed
+import XMonad.Layout.Combo
+import XMonad.Layout.Mosaic
+import XMonad.Layout.Named
+import XMonad.Layout.LayoutCombinators
+import XMonad.Layout.Square
+import XMonad.Layout.LayoutScreens
+import XMonad.Layout.WindowNavigation
+import XMonad.Layout.NoBorders
+import XMonad.Layout.WorkspaceDir
+import XMonad.Layout.ToggleLayouts
+
+import XMonad.Prompt
+import XMonad.Prompt.Layout
+import XMonad.Prompt.Shell
+
+import XMonad.Actions.CopyWindow
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Actions.RotView
+
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.UrgencyHook
+
+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_z     ),
+       layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))
+    , ((modMask x .|. shiftMask .|. controlMask, xK_z),
+       layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900]))
+    , ((modMask x .|. shiftMask, xK_Right), rotView True)
+    , ((modMask x .|. shiftMask, xK_Left), rotView False)
+    , ((modMask x, 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)
+
+-- keybindings for Mosaic:
+    , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
+    , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
+    , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
+    , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
+    , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
+    , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
+    , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
+
+    ]
+ 
+    ++
+    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 = -- withUrgencyHook FocusUrgencyHook $
+         withUrgencyHook NoUrgencyHook $
+         defaultConfig
+         { borderWidth = 1 -- Width of the window border in pixels.
+         , XMonad.workspaces = ["1:mutt","2:iceweasel"]
+         , layoutHook = workspaceDir "~" $ windowNavigation $
+                        toggleLayouts (noBorders Full) $ avoidStruts $
+                        Named "tabbed" (noBorders mytab) |||
+                        Named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
+                        Named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
+                        Named "widescreen" ((mytab *||* mytab)
+                                                ****//* combineTwo Square mytab mytab) --   |||
+                        --mosaic 0.25 0.5
+         , 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 defaultTConf
+
+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 t s | drop (length s - length t) s == t = Just $ take (length s - length t) s
+                 | otherwise = Nothing
+
+dropFromHead :: String -> String -> Maybe String
+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 myTConf)
+        , manageHook = manageHook defaultConfig <+> manageDocks
+        }
+ where
+    tiled   = HintedTile 1 0.03 0.5
+
+    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"
+    myTConf = defaultTConf { 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: an 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
+(Oct. 2007) tarball here:
+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.5>
+
+-}
+
+{- $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,150 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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, 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.
+
+An alternative is to inline the entire default config file from
+xmonad, and edit values you wish to change. This is requires more
+work, but some users may find this easier. You can find the defaults
+in the "XMonad.Config" module of the core xmonad library.
+
+However, note that (unlike previous versions of xmonad) you should not
+edit Config.hs itself.
+
+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.1: 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.
+
+-}
+
+{- $load
+#Loading_your_configuration#
+
+To get xmonad to use your new settings, type @mod-q@. 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,295 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Doc.Developing
+-- Copyright   :  (C) 2007 Andrea Rossato
+-- License     :  BSD3
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- This module documents the xmonad internals. It is intended for
+-- advanced users who are curious about the xmonad source code and
+-- want an brief overview. This document may also be helpful for the
+-- beginner\/intermediate Haskell programmer who is motivated to write
+-- an xmonad extension as a way to deepen her understanding of this
+-- powerful functional language; however, there is not space here to
+-- go into much detail.  A more comprehensive document introducing
+-- beginner\/intermediate Haskell programmers to the xmonad source is
+-- planned for the xmonad users' wiki
+-- (<http://haskell.org/haskellwiki/Xmonad>).
+--
+-- 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.
+--
+-----------------------------------------------------------------------------
+
+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>.
+
+-}
+
+{- $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,880 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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.CycleWS": move between workspaces.
+
+* "XMonad.Actions.DeManage": cease management of a window without
+  unmapping it.
+
+* "XMonad.Actions.DwmPromote": dwm-like master window swapping.
+
+* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces.
+
+* "XMonad.Actions.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.RotSlaves": rotate non-master windows.
+
+* "XMonad.Actions.RotView": cycle through non-empty workspaces.
+
+* "XMonad.Actions.Search": provide helpful functions for easily
+  running web searchs.
+
+* "XMonad.Actions.SimpleDate": display the date in a popup menu.
+
+* "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.Warp": warp the pointer.
+
+* "XMonad.Actions.WindowBringer": bring windows to you, and you to
+  windows.
+
+* "XMonad.Actions.WmiiActions": wmii-style actions.
+
+-}
+
+{- $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.EwmhDesktops": support for pagers in panel applications.
+
+* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately.
+
+* "XMonad.Hooks.ManageHelpers": provide helper functions to be used
+  in @manageHook@.
+
+* "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.Dishes": stack extra windows underneath the master windows.
+
+* "XMonad.Layout.DragPane": split the screen into two windows with a
+  draggable divider.
+
+* "XMonad.Layout.Grid": put windows in a square grid.
+
+* "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.Mosaic": tries to give each window a
+  user-configurable relative area
+
+* "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.ResizableTile": tiled layout allowing you to change
+  width and height of windows.
+
+* "XMonad.Layout.Roledex": a \"completely pointless layout which acts
+  like Microsoft's Flip 3D\".
+
+* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching.
+
+* "XMonad.Layout.Spiral": Fibonacci spiral layout.
+
+* "XMonad.Layout.Square": split the screen into a square area plus the rest.
+
+* "XMonad.Layout.Tabbed": a tabbed layout.
+
+* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two.
+
+* "XMonad.Layout.TilePrime": fill gaps created by resize hints.
+
+* "XMonad.Layout.ToggleLayouts": toggle between two layouts.
+
+* "XMonad.Layout.TwoPane": split the screen horizontally and show two
+  windows.
+
+* "XMonad.Layout.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.Directory"
+
+* "XMonad.Prompt.Layout"
+
+* "XMonad.Prompt.Man"
+
+* "XMonad.Prompt.Shell"
+
+* "XMonad.Prompt.Ssh"
+
+* "XMonad.Prompt.Window"
+
+* "XMonad.Prompt.Workspace"
+
+* "XMonad.Prompt.XMonad"
+
+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.Anneal": The goal is to bring the system, from an
+  arbitrary initial state, to a state with the minimum possible
+  energy.
+
+* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to
+  configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings");
+
+* "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.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:
+
+>    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 "Graphics.X11.Xlib"
+(for the symbols such as @xK_F12@), "XMonad.Prompt",
+"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":
+
+> import Graphics.X11.Xlib
+> import ...  -- and so on
+
+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 other ways of defining @newKeys@; for instance,
+you could define it like this:
+
+>    newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x)
+
+However, the simplest way to add new key bindings is to use some
+utilities provided by the xmonad-contrib library.  For instance,
+"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide
+useful functions for editing your key bindings.  Look, for instance, at
+'XMonad.Util.EZConfig.additionalKeys'.
+
+ -}
+
+{- $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.Layouts
+>
+>    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.Layouts
+>
+>    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.
+
+(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.
+
+-}
+
+{- $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,252 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+--
+-- DynamicLog
+--
+-- By default, log events in:
+--
+-- >     1 2 [3] 4 8
+--
+-- format, although the format is highly customizable.
+-- Suitable to pipe into dzen or xmobar.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicLog (
+    -- * Usage
+    -- $usage
+    dynamicLog,
+    dynamicLogDzen,
+    dynamicLogXmobar,
+    dynamicLogWithPP,
+    dynamicLogXinerama,
+    dzen,
+
+    pprWindowSet,
+    pprWindowSetXinerama,
+
+    PP(..), defaultPP, dzenPP, sjanssenPP,
+    wrap, pad, shorten,
+    xmobarColor, dzenColor, dzenEscape,
+    makeSimpleDzenConfig
+  ) where
+
+--
+-- Useful imports
+--
+import XMonad
+import Data.Maybe ( isJust )
+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
+-- >    main = xmonad defaultConfig { logHook = dynamicLog }
+
+-- | An example xmonad config that spawns a new dzen toolbar and uses the default
+-- dynamic log output
+makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full)))
+makeSimpleDzenConfig = do
+  h <- spawnPipe "dzen2"
+  return defaultConfig
+           { defaultGaps = [(18,0,0,0)]
+           , logHook = dynamicLogWithPP dzenPP
+                                          { ppOutput = hPutStrLn h } }
+
+-- |
+--
+-- Run xmonad with a dzen status bar set to some nice defaults. Output
+-- 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.
+--
+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, print a status bar output to stdout, in the form:
+--
+-- > 1 2 [3] 4 7 : full : title
+--
+-- That is, the currently populated workspaces, the current
+-- workspace layout, and the title of the focused window.
+--
+dynamicLog :: X ()
+dynamicLog = dynamicLogWithPP defaultPP
+
+-- |
+-- A log function that uses the 'PP' hooks to customize output.
+dynamicLogWithPP :: PP -> X ()
+dynamicLogWithPP pp = do
+    winset <- gets windowset
+    urgents <- readUrgents
+    sort' <- getSortByTag
+    -- layout description
+    let ld = description . S.layout . S.workspace . S.current $ winset
+    -- workspace list
+    let ws = pprWindowSet sort' urgents pp winset
+    -- window title
+    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
+
+    io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $
+                        [ ws
+                        , ppLayout pp ld
+                        , ppTitle  pp wt
+                        ]
+
+-- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen
+-- Requires dzen. Workspaces, xinerama, layouts and the window title are handled.
+--
+dynamicLogDzen :: X ()
+dynamicLogDzen = dynamicLogWithPP dzenPP
+
+pprWindowSet :: ([WindowSpace] -> [WindowSpace]) -> [Window] -> PP -> WindowSet -> String
+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
+--
+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 :: String -> String -> String -> String
+wrap _ _ "" = ""
+wrap l r m  = l ++ m ++ r
+
+pad :: String -> String
+pad = wrap " " " "
+
+shorten :: Int -> String -> String
+shorten n xs | length xs < n = xs
+             | otherwise     = (take (n - length end) xs) ++ end
+ where
+    end = "..."
+
+sepBy :: String -> [String] -> String
+sepBy sep = concat . intersperse sep . filter (not . null)
+
+dzenColor :: String -> String -> 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])
+
+xmobarColor :: String -> String -> String -> String
+xmobarColor fg bg = wrap t "</fc>"
+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
+
+-- | The 'PP' type allows the user to customize various behaviors of
+-- dynamicLogPP
+data PP = PP { ppCurrent, ppVisible
+             , ppHidden, ppHiddenNoWindows
+             , ppUrgent :: WorkspaceId -> String
+             , ppSep, ppWsSep :: String
+             , ppTitle :: String -> String
+             , ppLayout :: String -> String
+             , ppOrder :: [String] -> [String]
+             , ppOutput :: String -> IO ()
+             }
+
+-- | 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
+               }
+
+-- | 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
+                     }
+
+-- | The options that sjanssen likes to use, as an example.  Note the use of
+-- 'xmobarColor' and the record update on defaultPP
+sjanssenPP :: PP
+sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000"
+                       , ppTitle = xmobarColor "#00ee00" "" . shorten 80
+                       }
+
+-- | These are good defaults to be used with the xmobar status bar
+dynamicLogXmobar :: X ()
+dynamicLogXmobar =
+    dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
+                               , ppTitle   = xmobarColor "green"  "" . shorten 40
+                               , ppVisible = wrap "(" ")"
+                               }

XMonad/Hooks/EwmhDesktops.hs

@@ -0,0 +1,151 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.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 XMonad.Hooks.EwmhDesktops (
+    -- * Usage
+    -- $usage
+    ewmhDesktopsLogHook
+    ) 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
+
+-- $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 ()
+-- >
+-- > main = xmonad defaultConfig { logHook = myLogHook }
+-- 
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+
+-- | 
+-- Notifies pagers and window lists, such as those in the gnome-panel
+-- of the current state of workspaces and windows.
+ewmhDesktopsLogHook :: X ()
+ewmhDesktopsLogHook = withWindowSet $ \s -> do
+    sort' <- getSortByTag
+    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 ()
+
+
+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_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,162 @@
+{-# 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 Data.Maybe (catMaybes, fromMaybe)
+import Control.Monad
+
+-- $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)
+--
+-- 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
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+r2c :: Rectangle -> RectC
+r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w, fi y + fi h)
+
+c2r :: RectC -> Rectangle
+c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1) (fi $ y2 - y1)
+
+-- | Adjust layout automagically.
+avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a
+avoidStruts = AvoidStruts True
+
+data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show )
+
+data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)
+instance Message ToggleStruts
+
+instance LayoutClass l a => LayoutClass (AvoidStruts l) a where
+    doLayout (AvoidStruts True lo) r s =
+        do rect <- fmap ($ r) calcGap
+           (wrs,mlo') <- doLayout lo rect s
+           return (wrs, AvoidStruts True `fmap` mlo')
+    doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s
+                                             return (wrs, AvoidStruts False `fmap` mlo')
+    handleMessage (AvoidStruts b l) m
+        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l
+        | otherwise = do ml' <- handleMessage l m
+                         return (AvoidStruts b `fmap` ml')
+    description (AvoidStruts _ l) = description l
+
+data Side = L | R | T | B
+
+type Strut = (Side, CLong, CLong, CLong)
+
+type RectC = (CLong, CLong, CLong, CLong)
+
+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)
+    inRange (a, b) c = c > a && c < b
+    p (a, b) = inRange (a, b) l || inRange (a, b) h || inRange (a, b) l || inRange (l, h) b

XMonad/Hooks/ManageHelpers.hs

@@ -0,0 +1,130 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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'
+) 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 it's parent.
+transience :: MaybeManageHook
+transience = transientTo </=? Nothing 
+             -?>> move
+                 where move :: Maybe Window -> ManageHook
+                       move mw = maybe idHook (doF . move') mw
+                                 where move' :: Window -> (WindowSet -> WindowSet)
+                                       move' w = \s -> maybe s (`W.shift` s) (W.findTag w s)
+
+-- | 'transience' set to a 'ManageHook'
+transience' :: ManageHook
+transience' = maybeToDefinite transience
+
+-- | converts 'MaybeManageHook's to 'ManageHook's
+maybeToDefinite :: MaybeManageHook -> ManageHook
+maybeToDefinite = fmap (fromMaybe mempty)

XMonad/Hooks/SetWMName.hs

@@ -0,0 +1,112 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.SetWMName
+-- Copyright   :  © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com>
+-- License     :  BSD
+--
+-- Maintainer  :  Ivan.Tarasov@gmail.com
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Sets the WM name to a given string, so that it could be detected using
+-- _NET_SUPPORTING_WM_CHECK protocol.
+--
+-- May be useful for making Java GUI programs work, just set WM name to "LG3D"
+-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.
+--
+-- Remember that you need to call the setWMName action yourself (at least until
+-- we have startup hooks). E.g., you can bind it in your Config.hs:
+--
+-- > ((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
+-- 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 XMonad.Hooks.SetWMName (
+    setWMName) where
+
+import Control.Monad (join)
+import Data.Char (ord)
+import Data.List (nub)
+import Data.Maybe (fromJust, listToMaybe, maybeToList)
+import Foreign.C.Types (CChar)
+
+import Foreign.Marshal.Alloc (alloca)
+
+import XMonad
+
+-- | sets WM name
+setWMName :: String -> X ()
+setWMName name = do
+    atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
+    atom_NET_WM_NAME <- getAtom "_NET_WM_NAME"
+    atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED"
+    atom_UTF8_STRING <- getAtom "UTF8_STRING"
+
+    root <- asks theRoot
+    supportWindow <- getSupportWindow
+    dpy <- asks display
+    io $ 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 (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)
+  where
+    netSupportingWMCheckAtom :: X Atom
+    netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
+
+    latin1StringToCCharList :: String -> [CChar]
+    latin1StringToCCharList str = map (fromIntegral . ord) str
+
+    getSupportWindow :: X Window
+    getSupportWindow = withDisplay $ \dpy -> do
+        atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
+        root <- asks theRoot
+        supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root
+        validateWindow (fmap fromIntegral supportWindow)
+
+    validateWindow :: Maybe Window -> X Window
+    validateWindow w = do
+        valid <- maybe (return False) isValidWindow w
+        if valid then
+            return $ fromJust w
+          else
+            createSupportWindow
+
+    -- is there a better way to check the validity of the window?
+    isValidWindow :: Window -> X Bool
+    isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do
+        status <- xGetWindowAttributes dpy w p
+        return (status /= 0)
+
+    -- this code was translated from C (see OpenBox WM, screen.c)
+    createSupportWindow :: X Window
+    createSupportWindow = withDisplay $ \dpy -> do
+        root <- asks theRoot
+        let visual = defaultVisual dpy (defaultScreen dpy)  -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib
+        window <- io $ allocaSetWindowAttributes $ \winAttrs -> do
+            set_override_redirect winAttrs True         -- WM cannot decorate/move/close this window
+            set_event_mask winAttrs propertyChangeMask  -- not sure if this is needed
+            let bogusX = -100
+                bogusY = -100
+              in
+                createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs
+        io $ mapWindow dpy window   -- not sure if this is needed
+        io $ lowerWindow dpy window -- not sure if this is needed
+        return window

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

@@ -0,0 +1,90 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.XPropManage
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- A ManageHook matching on XProperties.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.XPropManage (
+                 -- * Usage
+                 -- $usage
+                 xPropManageHook, XPropMatch, pmX, pmP
+                 ) where
+
+import Data.Char (chr)
+import Data.List (concat)
+import Data.Monoid (mconcat, Endo(..))
+
+import Control.Monad.Trans (lift)
+
+import XMonad
+import XMonad.ManageHook ((-->))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.XPropManage
+-- > import qualified XMonad.StackSet as W
+-- > import XMonad.Actions.TagWindows
+-- > import Data.List
+--
+-- > manageHook = xPropManageHook xPropMatches 
+-- >
+-- > xPropMatches :: [XPropMatch]
+-- > 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"))
+-- >                ]
+--
+-- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND
+--
+-- A XPropMatch consists of a list of conditions and function telling what to do.
+--
+-- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1,
+-- and an function which matches onto the value of the property (represented as a List
+-- of Strings).
+--
+-- If a match succeeds the function is called immediately, can perform any action and then return
+-- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the
+-- WindowSet use just 'pmP function'.
+--
+-- \*1 You can get the available properties of an application with the xprop utility. STRING properties
+-- should work fine. Others might not work.
+--
+
+type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))
+
+pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
+pmX f w = f w >> return id
+
+pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)
+pmP f _ = return f
+
+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
+    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
+    let filt q | q == wM_COMMAND = concat . map splitAtNull
+               | 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

@@ -0,0 +1,55 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Accordion
+-- Copyright   :  (c) glasser@mit.edu
+-- License     :  BSD
+--
+-- Maintainer  :  glasser@mit.edu
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- LayoutClass that puts non-focused windows in ribbons at the top and bottom
+-- of the screen.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Accordion (
+    -- * Usage
+    -- $usage
+    Accordion(Accordion)) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import Data.Ratio
+
+-- $usage
+-- 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 )
+
+instance LayoutClass Accordion Window where
+    pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
+     where
+       ups    = W.up ws
+       dns    = W.down ws
+       (top,  allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc
+       (center,  bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop
+       (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) sc
+       mainPane | ups /= [] && dns /= [] = center
+                | ups /= []              = allButTop
+                | dns /= []              = allButBottom
+                | otherwise              = sc
+       tops    = if ups /= [] then splitVertically (length ups) top    else []
+       bottoms = if dns /= [] then splitVertically (length dns) bottom else []

XMonad/Layout/Circle.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Circle
+-- Module      :  XMonad.Layout.Circle
 -- Copyright   :  (c) Peter De Wachter
 -- License     :  BSD-style (see LICENSE)
 --
@@ -12,28 +14,35 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Circle (
+module XMonad.Layout.Circle (
                              -- * Usage
                              -- $usage
-                             circle
+                             Circle (..)
                             ) where -- actually it's an ellipse
 
 import Data.List
-import Graphics.X11.Xlib
 import XMonad
-import StackSet (integrate, peek)
-
-import XMonadContrib.LayoutHelpers ( idModify )
+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
+-- > 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"
 
-circle :: Layout Window
-circle = Layout { doLayout = \r s -> do { layout <- raiseFocus $ circleLayout r $ integrate s
-                                       ;  return (layout, Nothing) }
-                , modifyLayout = idModify }
+data Circle a = Circle deriving ( Read, Show )
+
+instance LayoutClass Circle Window where
+    doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s
+                             return (layout, Nothing)
 
 circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]
 circleLayout _ []     = []

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, 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') <- doLayout super rinput superstack
+                     (wrs1, ml1') <- runLayout l1 r1 s1
+                     (wrs2, ml2') <- runLayout l2 r2 s2
+                     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/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

@@ -0,0 +1,136 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.DragPane
+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
+--                    David Roundy <droundy@darcs.net>,
+--                    Andrea Rossato <andrea.rossato@unibz.it>
+-- License     :  BSD3-style (see LICENSE)
+-- 
+-- Maintainer  :  David Roundy <droundy@darcs.net>
+--                Andrea Rossato <andrea.rossato@unibz.it>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Layouts that splits the screen either horizontally or vertically and
+-- shows two windows.  The first window is always the master window, and
+-- the other is either the currently focused window or the second window in
+-- layout order.
+
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.DragPane (
+                               -- * Usage
+                               -- $usage
+                                dragPane
+                              , DragPane, DragType (..)
+                              ) where
+
+import XMonad
+import Data.Unique
+
+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@:
+--
+-- > import XMonad.Layout.DragPane
+--
+-- Then edit your @layoutHook@ by adding the DragPane layout:
+--
+-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+halfHandleWidth :: Integral a => a
+halfHandleWidth = 1
+
+handleColor :: String
+handleColor = "#000000"
+
+dragPane :: DragType -> Double -> Double -> DragPane a
+dragPane t x y = DragPane (I Nothing) t x y
+
+data DragPane a = 
+    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double 
+             deriving ( Show, Read )
+
+data DragType = Horizontal | Vertical deriving ( Show, Read )
+
+instance LayoutClass DragPane a where
+    doLayout d@(DragPane _ Vertical   _ _) = doLay id d
+    doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d
+    handleMessage = handleMess
+
+data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )
+instance Message SetFrac
+
+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
+    | Just Hide             <- fromMessage x = do hideWindow win
+                                                  return $ Just (DragPane mb ty delta split)
+    | Just ReleaseResources <- fromMessage x = do deleteWindow win
+                                                  return $ Just (DragPane (I Nothing) ty delta split)
+    -- layout specific messages
+    | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
+    | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
+                                     return $ Just (DragPane mb ty delta frac)
+handleMess _ _ = return Nothing
+
+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_x r))/(fromIntegral $ rect_width r)
+             sendMessage (SetFrac ident frac))
+            (return ())
+handleEvent _ _  = return ()
+
+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'
+      left = case left' of Rectangle x y w h ->
+                               mirror $ Rectangle x y (w-halfHandleWidth) h
+      right = case right' of
+                Rectangle x y w 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
+      wrs = case reverse (W.up s) of
+              (master:_) -> [(master,left),(W.focus s,right)]
+              [] -> case W.down s of
+                      (next:_) -> [(W.focus s,left),(next,right)]
+                      [] -> [(W.focus s, r)]
+  if length wrs > 1 
+     then case mw of
+            I (Just (w,_,ident)) -> do 
+                    w' <- deleteWindow w >> newDragWin handr
+                    return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)
+            I Nothing -> do 
+                    w <- newDragWin handr
+                    i <- io $ newUnique
+                    return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)
+     else return (wrs, Nothing)
+
+
+newDragWin :: Rectangle -> X Window
+newDragWin r = do
+  let mask = Just $ exposureMask .|. buttonPressMask
+  w <- createNewWindow r mask handleColor False
+  showWindow  w
+  return      w

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(..)
+) 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,109 @@
+{-# 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(..)) 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 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
+    , orientation :: Orientation
+    } deriving ( Show, Read )
+
+data Orientation = Wide | Tall deriving ( Show, Read )
+
+instance LayoutClass HintedTile Window where
+    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do
+        bhs <- mapM getHints w
+        let (masters, slaves) = splitAt nm bhs
+        return (zip w (tiler masters slaves), Nothing)
+     where
+        w = W.integrate w'
+        tiler masters slaves
+            | null masters || null slaves = divide o (masters ++ slaves) r
+            | otherwise = split o f r (divide o masters) (divide o slaves)
+
+    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)
+
+-- Divide the screen vertically (horizontally) into n subrectangles
+divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle]
+divide _ [] _ = []
+divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
+      (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
+ where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs)))
+
+divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
+      (divide 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/LayoutCombinators.hs

@@ -0,0 +1,216 @@
+{-# 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
+--
+-- A module for combining other layouts.
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.LayoutCombinators (
+    -- * Usage
+    -- $usage
+
+    -- * Combinators using DragPane vertical
+    -- $dpv
+    (*||*), (**||*),(***||*),(****||*),(***||**),(****||***),
+    (***||****),(*||****),(**||***),(*||***),(*||**),
+
+    -- * Combinators using DragPane horizontal
+    -- $dph
+    (*//*), (**//*),(***//*),(****//*),(***//**),(****//***),
+    (***//****),(*//****),(**//***),(*//***),(*//**),
+
+    -- * Combinators using Tall (vertical)
+    -- $tv
+    (*|*), (**|*),(***|*),(****|*),(***|**),(****|***),
+    (***|****),(*|****),(**|***),(*|***),(*|**),
+
+    -- * Combinators using Mirror Tall (horizontal)
+    -- $mth
+    (*/*), (**/*),(***/*),(****/*),(***/**),(****/***),
+    (***/****),(*/****),(**/***),(*/***),(*/**),
+
+    -- * A new combinator
+    -- $nc
+    (|||),
+    JumpToLayout(JumpToLayout)
+    ) where
+
+import Data.Maybe ( isJust, isNothing )
+
+import XMonad hiding ((|||))
+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@ by using the new layout combinators:
+--
+-- > 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"
+
+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 (a wide layout).
+(*/*),(**/*),(***/*),(****/*), (***/**),(****/***),
+       (***/****),(*/****),(**/***),(*/***),(*/**) :: (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 |||
+
+-- $nc
+-- A new layout combinator that allows the use of a prompt to change
+-- layout. For more information see "Xmonad.Prompt.Layout"
+(|||) :: (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
+
+data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable )
+instance Message JumpToLayout
+
+instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
+    doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s
+                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
+    doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s
+                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
+    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,61 @@
+{-# 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
+
+-- $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 _ _ _ xs = do
+                            bW <- asks (borderWidth . config)
+                            xs' <- mapM (applyHint bW) xs
+                            return (xs', Nothing)
+     where
+        applyHint bW (w,Rectangle a b c d) =
+            withDisplay $ \disp -> do
+                sh <- io $ getWMNormalHints disp w
+                let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d)
+                return (w, Rectangle a b c' d')

XMonad/Layout/LayoutModifier.hs

@@ -0,0 +1,74 @@
+{-# 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 Llayouts and layout modifiers
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.LayoutModifier (
+    -- * Usage
+    -- $usage
+    LayoutModifier(..), ModifiedLayout(..)
+    ) where
+
+import XMonad
+import XMonad.StackSet ( Stack )
+
+-- $usage
+-- Use LayoutModifier to help write easy Layouts.
+--
+-- LayouModifier defines a class 'LayoutModifier'. Each method as a
+-- default implementation.
+--
+-- For usage examples you can see "XMonad.Layout.WorkspaceDir",
+-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder",
+
+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
+    handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
+    handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
+                                          return (Left `fmap` mm')
+    redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
+               -> 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 = const ""
+
+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 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) = modifierDescription m <> description l
+     where "" <> x = x
+           x <> y = x ++ " " ++ y
+
+data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )

XMonad/Layout/LayoutScreens.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.LayoutScreens
+-- Module      :  XMonad.Layout.LayoutScreens
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
 --
@@ -10,19 +12,14 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.LayoutScreens (
+module XMonad.Layout.LayoutScreens (
                                     -- * Usage
                                     -- $usage
-                                    layoutScreens
+                                    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
@@ -30,22 +27,39 @@ import Graphics.X11.Xlib.Extras
 -- separate screens.  This should definitely be useful for testing the
 -- behavior of xmonad under Xinerama, and it's possible that it'd also be
 -- handy for use as an actual user interface, if you've got a very large
--- sceen and long for greater flexibility (e.g. being able to see your
+-- 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 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 :: Int -> Layout Int -> X ()
+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 }) ->
+       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))
@@ -58,3 +72,11 @@ getWindowRectangle w = withDisplay $ \d ->
     do a <- io $ getWindowAttributes d w
        return $ Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)
                           (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)
+
+data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)
+
+instance LayoutClass FixedLayout a where
+    doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing)
+
+fixedLayout :: [Rectangle] -> FixedLayout a
+fixedLayout = FixedLayout

XMonad/Layout/MagicFocus.hs

@@ -0,0 +1,56 @@
+{-# 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(MagicFocus)
+    ) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $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"
+
+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

XMonad/Layout/Magnifier.hs

@@ -0,0 +1,142 @@
+{-# 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',
+      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 (12%10)
+--
+-- to use a custom level of magnification.  You can even make the focused
+-- window smaller for a pop in effect. Keep in mind, you must
+--
+-- > import Data.Ratio
+--
+-- in order to use rationals (such as @12%10@) in your config.
+--
+-- 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   )
+--
+-- 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)
+
+-- | Increase the size of the window that has focus by a custom zoom,
+-- unless if it is the master window.
+magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
+magnifiercz' cz = ModifiedLayout (Mag ((fromRational cz)*1.0::Double) On NoMaster)
+
+data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable )
+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 + 0.1) Off t)
+    handleMess (Mag z Off t) m
+                    | Just ToggleOn    <- 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, shrink 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
+
+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')

XMonad/Layout/Maximize.hs

@@ -0,0 +1,79 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Maximize
+-- Copyright   :  (c) 2007 James Webb
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  xmonad#jwebb,sygneca,com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Temporarily yanks the focused window out of the layout to mostly fill
+-- the screen.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.Maximize (
+        -- * Usage
+        -- $usage
+        maximize,
+        maximizeRestore
+    ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import Data.List ( partition )
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Maximize
+--
+-- Then edit your @layoutHook@ by adding the Maximize layout modifier:
+--
+-- > 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))
+-- >        ...
+--
+-- 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
+maximize = ModifiedLayout $ Maximize Nothing
+
+data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq )
+instance Message MaximizeRestore
+maximizeRestore :: Window -> MaximizeRestore
+maximizeRestore = MaximizeRestore
+
+instance LayoutModifier Maximize Window where
+    modifierDescription (Maximize _) = "Maximize"
+    redoLayout (Maximize mw) rect _ wrs = case mw of
+        Just win ->
+                return (maxed ++ rest, Nothing)
+            where
+                maxed = map (\(w, _) -> (w, maxRect)) toMax
+                (toMax, rest) = partition (\(w, _) -> w == win) wrs
+                maxRect = Rectangle (rect_x rect + 50) (rect_y rect + 50)
+                    (rect_width rect - 100) (rect_height rect - 100)
+        Nothing -> return (wrs, Nothing)
+    handleMess (Maximize mw) m = case fromMessage m of
+        Just (MaximizeRestore w) -> case mw of
+            Just _ -> return $ Just $ Maximize Nothing
+            Nothing -> return $ Just $ Maximize $ Just w
+        _ -> return Nothing
+
+-- vim: sw=4:et

XMonad/Layout/Mosaic.hs

@@ -1,4 +1,5 @@
 {-# OPTIONS -fglasgow-exts #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.Mosaic
@@ -14,67 +15,71 @@
 -- ratios configurable at run-time by the user.
 --
 -----------------------------------------------------------------------------
-module XMonadContrib.Mosaic (
+module XMonad.Layout.Mosaic (
                              -- * Usage
                              -- $usage
                              mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,
                              tallWindow, wideWindow, flexibleWindow,
-                             getName, withNamedWindow ) where
+                             getName ) where
 
 import Control.Monad.State ( State, put, get, runState )
 import System.Random ( StdGen, mkStdGen )
+import Data.Maybe ( isJust )
 
-import Data.Ratio
-import Graphics.X11.Xlib
 import XMonad hiding ( trace )
-import Operations ( full, Resize(Shrink, Expand) )
-import qualified StackSet as W
+import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 import Data.List ( sort )
 import Data.Typeable ( Typeable )
 import Control.Monad ( mplus )
 
-import XMonadContrib.NamedWindows
-import XMonadContrib.Anneal
+import XMonad.Util.NamedWindows
+import XMonad.Util.Anneal
 
 -- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- Key bindings:
--- 
--- You can use this module with the following in your config file:
+-- > import XMonad.Layout.Mosaic
 --
--- > import XMonadContrib.Mosaic
+-- Then edit your @layoutHook@ by adding the Mosaic layout:
 --
--- > defaultLayouts :: [Layout Window]
--- > defaultLayouts = [ mosaic 0.25 0.5 M.empty, full ]
+-- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 --
 -- In the key-bindings, do something like:
 --
--- >   , ((controlMask .|. modMask .|. 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))
--- 
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))
+-- >   , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))
+-- >   , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))
+-- >   , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))
+-- >   , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))
+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
-data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow
-                  | SquareWindow NamedWindow | ClearWindow NamedWindow
-                  | TallWindow NamedWindow | WideWindow NamedWindow
-                  | FlexibleWindow NamedWindow
+data HandleWindow = ExpandWindow Window | ShrinkWindow Window
+                  | SquareWindow Window | ClearWindow Window
+                  | TallWindow Window | WideWindow Window
+                  | FlexibleWindow Window
                     deriving ( Typeable, Eq )
 
 instance Message HandleWindow
 
-expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow
-expandWindow = ExpandWindow
-shrinkWindow = ShrinkWindow
-squareWindow = SquareWindow
+expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow
+expandWindow   = ExpandWindow
+shrinkWindow   = ShrinkWindow
+squareWindow   = SquareWindow
 flexibleWindow = FlexibleWindow
-myclearWindow = ClearWindow
-tallWindow = TallWindow
-wideWindow = WideWindow
+myclearWindow  = ClearWindow
+tallWindow     = TallWindow
+wideWindow     = WideWindow
 
 largeNumber :: Int
 largeNumber = 50
@@ -85,62 +90,113 @@ 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)
+mosaic :: Double -> Double -> MosaicLayout Window
+mosaic d t = Mosaic d t M.empty
 
-multiply_area :: Double -> NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
+data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint])
+              deriving ( Show, Read )
+
+instance LayoutClass MosaicLayout Window where
+    doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h
+                                      mosaicL t all_hints r (W.integrate st)
+        where add_hints [] x = return x
+              add_hints (w:ws) x =
+                  do z <- withDisplay $ \d -> io $ getWMNormalHints d w
+                     let set_asp = case map4 `fmap` sh_aspect z of
+                                   Just ((minx,miny),(maxx,maxy))
+                                       | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id
+                                       | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w
+                                   _ -> id
+                     add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x
+              map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double))
+              map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d))
+
+    pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m)
+        where
+          m1 Shrink             = Mosaic d (t/(1+d)) h
+          m1 Expand             = Mosaic d (t*(1+d)) h
+          m2 (ExpandWindow w)   = Mosaic d t (multiply_area (1+d) w h)
+          m2 (ShrinkWindow w)   = Mosaic d t (multiply_area (1/(1+ d)) w h)
+          m2 (SquareWindow w)   = Mosaic d t (set_aspect_ratio 1 w h)
+          m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h)
+          m2 (TallWindow w)     = Mosaic d t (multiply_aspect (1/(1+d)) w h)
+          m2 (WideWindow w)     = Mosaic d t (multiply_aspect (1+d) w h)
+          m2 (ClearWindow w)    = Mosaic d t (M.delete w h)
+
+    description _ = "mosaic"
+
+multiply_area :: Double -> Window
+              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
 multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)]
                                     f (RelArea a':xs) = RelArea (a'*a) : xs
                                     f (x:xs) = x : f xs
 
-set_aspect_ratio :: Double -> NamedWindow
-                 -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
+set_aspect_ratio :: Double -> Window
+                 -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
 set_aspect_ratio r = alterlist f where f [] = [AspectRatio r]
                                        f (FlexibleAspectRatio _:x) = AspectRatio r:x
                                        f (AspectRatio _:x) = AspectRatio r:x
                                        f (x:xs) = x:f xs
 
-make_flexible :: NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
+make_flexible :: Window
+              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
 make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r
                                         f (FlexibleAspectRatio r) = AspectRatio r
                                         f x = x
 
-multiply_aspect :: Double -> NamedWindow
-                -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
+multiply_aspect :: Double -> Window
+                -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
 multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r]
                                       f (AspectRatio r':x) = AspectRatio (r*r'):x
                                       f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x
                                       f (x:xs) = x:f xs
 
-findlist :: Ord k => k -> M.Map k [a] -> [a]
+set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
+set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx)
+           | otherwise = const id
+
+set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
+set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx)
+           | otherwise = const id
+
+isMaxX,isMaxY :: WindowHint -> Maybe Dimension
+isMaxX (MaxX x) = Just x
+isMaxX _ = Nothing
+isMaxY (MaxY x) = Just x
+isMaxY _ = Nothing
+
+set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
+set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx)
+           | otherwise = const id
+    where isMinX (MinX _) = True
+          isMinX _ = False
+
+set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]
+set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx)
+           | otherwise = const id
+    where isMinY (MinY _) = True
+          isMinY _ = False
+
+replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a]
+replaceinmap repl v = alterlist f where f [] = [v]
+                                        f (x:xs) | repl x = v:xs
+                                                 | otherwise = x:f xs
+
+findlist :: Window -> M.Map Window [a] -> [a]
 findlist = M.findWithDefault []
 
-alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a]
+alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a]
 alterlist f k = M.alter f' k
     where f' Nothing = f' (Just [])
           f' (Just xs) = case f xs of
                            [] -> Nothing
                            xs' -> Just xs'
 
-mosaicL :: Double -> M.Map NamedWindow [WindowHint]
-        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window))
+mosaicL :: Double -> M.Map Window [WindowHint]
+        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout 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
+    = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws
              -- TODO: remove all this dead code
              myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws
              myv2 = mc_mosaic sortedws Vertical
@@ -152,77 +208,95 @@ mosaicL f hints origRect origws
 --             myh2 = maxL $ runCountDown largeNumber $
 --                    sequence $ replicate mediumNumber $
 --                    mosaic_splits one_split origRect Horizontal sortedws
-         return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw,
+         return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw,
                                  --                           show $ rate f meanarea (findlist nw hints) r,
                                  --                           show r,
                                  --                           show $ area r/meanarea,
                                  --                           show $ findlist nw hints]) $
-                                 unName nw,crop' (findlist nw hints) r)) $
+                                 w,crop' (findlist w hints) r)) $
                 flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)
     where mosaic_splits _ _ _ [] = return $ Rated 0 $ M []
           mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r)
           mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws)
-          even_split :: Rectangle -> CutDirection -> [[NamedWindow]]
-                     -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle)))
+          even_split :: Rectangle -> CutDirection -> [[Window]]
+                     -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))
           even_split r d [ws] = even_split r d $ map (:[]) ws
           even_split r d wss =
               do let areas = map sumareas wss
-                 let wsr_s :: [([NamedWindow], Rectangle)]
-                     wsr_s = zip wss (partitionR d r areas)
+                     maxds = map (maxd d) wss
+                 let wsr_s :: [([Window], Rectangle)]
+                     wsr_s = zip wss (partitionR d r maxds areas)
                  submosaics <- mapM (\(ws',r') ->
                                      mosaic_splits even_split r' (otherDirection d) ws') wsr_s
                  return $ fmap M $ catRated submosaics
           {-
-          another_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
+          another_mosaic :: [Window] -> CutDirection
+                         -> Rated Double (Mosaic (Window,Rectangle))
           another_mosaic ws d = rate_mosaic ratew $
                                 rect_mosaic origRect d $
                                 zipML (example_mosaic ws) (map findarea ws)
           -}
-          mc_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
+          mc_mosaic :: [Window] -> CutDirection
+                    -> Rated Double (Mosaic (Window,Rectangle))
           mc_mosaic ws d = fmap (rect_mosaic origRect d) $
                            annealMax (zipML (example_mosaic ws) (map findarea ws))
                            (the_rating . rate_mosaic ratew . rect_mosaic origRect d )
                            changeMosaic
 
-          ratew :: (NamedWindow,Rectangle) -> Double
+          ratew :: (Window,Rectangle) -> Double
           ratew (w,r) = rate f meanarea (findlist w hints) r
-          example_mosaic :: [NamedWindow] -> Mosaic NamedWindow
+          example_mosaic :: [Window] -> Mosaic Window
           example_mosaic ws = M (map OM ws)
           rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle)
           rect_mosaic r _ (OM (w,_)) = OM (w,r)
           rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs
               where areas = map (sum . map snd . flattenMosaic) ws
-                    rs = partitionR d r areas
+                    maxds = repeat 1
+                    rs = partitionR d r maxds areas
                     d' = otherDirection d
-          rate_mosaic :: ((NamedWindow,Rectangle) -> Double)
-                      -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle))
+          rate_mosaic :: ((Window,Rectangle) -> Double)
+                      -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle))
           rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m
 {-
-          one_split :: Rectangle -> CutDirection -> [[NamedWindow]]
-                    -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle)))
+          one_split :: Rectangle -> CutDirection -> [[Window]]
+                    -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))
           one_split r d [ws] = one_split r d $ map (:[]) ws
           one_split r d wss =
               do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss]
-                 let wsr_s :: [([NamedWindow], Rectangle)]
+                 let wsr_s :: [([Window], Rectangle)]
                      wsr_s = zip wss (partitionR d r rnd)
                  submosaics <- mapM (\(ws',r') ->
                                      mosaic_splits even_split r' (otherDirection d) ws') wsr_s
                  return $ fmap M $ catRated submosaics
 -}
-          partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle]
-          partitionR _ _ [] = []
-          partitionR _ r [_] = [r]
-          partitionR d r (a:ars) = r1 : partitionR d r2 ars
+          partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle]
+          partitionR _ _ _ [] = []
+          partitionR _ _ [] _ = []
+          partitionR _ r _ [_] = [r]
+          partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars
               where totarea = sum (a:ars)
-                    (r1,r2) = split d (a/totarea) r
+                    totd = fromIntegral $ dimR d r
+                    (r1,r2) = if a/totarea > fromIntegral m / totd
+                              then if a/totarea > 1 - fromIntegral (sum ms) / totd
+                                   then split d (1 - fromIntegral (sum ms) / totd) r
+                                   else split d (a/totarea) r
+                              else split d (fromIntegral m / totd) r
           theareas = hints2area `fmap` hints
           sumareas ws = sum $ map findarea ws
-          findarea :: NamedWindow -> Double
+          maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws
+          maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws
+          findarea :: Window -> Double
           findarea w = M.findWithDefault 1 w theareas
+          findhinted fh d w = fh' $ M.findWithDefault [] w hints
+              where fh' [] = d
+                    fh' (h:hs) | Just x <- fh h = x
+                               | otherwise = fh' hs
           meanarea =  area origRect / fromIntegral (length origws)
 
+dimR :: CutDirection -> Rectangle -> Dimension
+dimR Vertical (Rectangle _ _ _ h) = h
+dimR Horizontal (Rectangle _ _ w _) = w
+
 maxL :: Ord a => [a] -> a
 maxL [] = error "maxL on empty list"
 maxL [a] = a
@@ -258,6 +332,10 @@ run_with_only limit j =
                                return x
 
 data WindowHint = RelArea Double
+                | MaxX Dimension
+                | MaxY Dimension
+                | MinX Dimension
+                | MinY Dimension
                 | AspectRatio Double
                 | FlexibleAspectRatio Double
                   deriving ( Show, Read, Eq, Ord )
@@ -274,15 +352,25 @@ rate defaulta meanarea xs rr
                   * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility
      where weight = hints2area xs
 
+crop1 :: WindowHint -> Rectangle -> Rectangle
+crop1 (FlexibleAspectRatio f) r = cropit f r
+crop1 h r = crop1' h r
+
+crop1' :: WindowHint -> Rectangle -> Rectangle
+crop1' (AspectRatio f) r = cropit f r
+crop1' (FlexibleAspectRatio f) r = cropit f r
+crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h
+                                     | otherwise = Rectangle x y w h
+crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm
+                                     | otherwise = Rectangle x y w h
+crop1' _ r = r
+
 crop :: [WindowHint] -> Rectangle -> Rectangle
-crop (AspectRatio f:_) = cropit f
-crop (FlexibleAspectRatio f:_) = cropit f
-crop (_:hs) = crop hs
+crop (h:hs) = crop hs . crop1 h
 crop [] = id
 
 crop' :: [WindowHint] -> Rectangle -> Rectangle
-crop' (AspectRatio f:_) = cropit f
-crop' (_:hs) = crop' hs
+crop' (h:hs) = crop' hs . crop1' h
 crop' [] = id
 
 cropit :: Double -> Rectangle -> Rectangle
@@ -307,6 +395,7 @@ a -/ b = fromIntegral a / b
 a -* b = fromIntegral a * b
 
 split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle)
+split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r
 split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h,
                                                Rectangle sx (sy+fromIntegral h) sw (sh-h))
     where h = floor $ fromIntegral sh * frac

XMonad/Layout/MosaicAlt.hs

@@ -0,0 +1,168 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.MosaicAlt
+-- Copyright   :  (c) 2007 James Webb
+-- License     :  BSD-style (see xmonad/LICENSE)
+-- 
+-- Maintainer  :  xmonad#jwebb,sygneca,com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout which gives each window a specified amount of screen space 
+-- relative to the others. Compared to the 'Mosaic' layout, this one
+-- divides the space in a more balanced way.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.MosaicAlt (
+        -- * Usage:
+        -- $usage
+        MosaicAlt(..)
+        , shrinkWindowAlt
+        , expandWindowAlt
+        , tallWindowAlt
+        , wideWindowAlt
+        , resetAlt
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified Data.Map as M
+import Data.List ( sortBy )
+import Data.Ratio
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.MosaicAlt
+-- > import qualified Data.Map as M
+--
+-- Then edit your @layoutHook@ by adding the MosaicAlt layout:
+--
+-- > 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)
+-- >     ...
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data HandleWindowAlt =
+    ShrinkWindowAlt Window
+    | ExpandWindowAlt Window
+    | TallWindowAlt Window
+    | WideWindowAlt Window
+    | ResetAlt
+    deriving ( Typeable, Eq )
+instance Message HandleWindowAlt
+shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt
+tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt
+shrinkWindowAlt = ShrinkWindowAlt
+expandWindowAlt = ExpandWindowAlt
+tallWindowAlt = TallWindowAlt
+wideWindowAlt = WideWindowAlt
+resetAlt :: HandleWindowAlt
+resetAlt = ResetAlt
+
+data Param = Param { area, aspect :: Rational } deriving ( Show, Read )
+type Params = M.Map Window Param
+data MosaicAlt a = MosaicAlt Params deriving ( Show, Read )
+
+instance LayoutClass MosaicAlt Window where
+    description _ = "MosaicAlt"
+    doLayout (MosaicAlt params) rect stack =
+            return (arrange rect stack params', Just $ MosaicAlt params')
+        where
+            params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params
+            ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins
+
+    handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of
+        Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1
+        Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1
+        Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4)
+        Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4)
+        Just ResetAlt -> Just $ MosaicAlt M.empty
+        _ -> Nothing
+
+-- Change requested params for a window.
+alter :: Params -> Window -> Rational -> Rational -> Params
+alter params win arDelta asDelta = case M.lookup win params of
+    Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params
+    Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params
+
+-- Layout algorithm entry point.
+arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]
+arrange rect stack params = r
+    where
+        (_, r) = findSplits 3 rect tree params
+        tree = makeTree (sortBy areaCompare wins) params
+        wins = reverse (W.up stack) ++ W.focus stack : W.down stack
+        areaCompare a b = or1 b `compare` or1 a
+        or1 w = maybe 1 area $ M.lookup w params
+
+-- Recursively group windows into a binary tree. Aim to balance the tree
+-- according to the total requested area in each branch.
+data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None
+makeTree :: [Window] -> Params -> Tree
+makeTree wins params = case wins of
+    [] -> None
+    [x] -> Leaf x
+    _ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params)
+        where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins
+
+-- Split a list of windows in half by area.
+areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))
+areaSplit params wins = gather [] 0 [] 0 wins
+    where
+        gather a aa b ba (r : rs) =
+            if aa <= ba
+                then gather (r : a) (aa + or1 r) b ba rs
+                else gather a aa (r : b) (ba + or1 r) rs
+        gather a aa b ba [] = ((reverse a, aa), (b, ba))
+        or1 w = maybe 1 area $ M.lookup w params
+
+-- Figure out which ways to split the space, by exhaustive search.
+-- Complexity is quadratic in the number of windows.
+findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])
+findSplits _ _ None _ = (0, [])
+findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)])
+findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params =
+        if hBadness < vBadness then (hBadness, hList) else (vBadness, vList)
+    where
+        (hBadness, hList) = trySplit splitHorizontallyBy
+        (vBadness, vList) = trySplit splitVerticallyBy
+        trySplit splitBy =
+                (aBadness + bBadness, aList ++ bList)
+            where
+                (aBadness, aList) = findSplits (depth - 1) aRect aTree params
+                (bBadness, bList) = findSplits (depth - 1) bRect bTree params
+                (aRect, bRect) = splitBy ratio rect
+        ratio = aArea / (aArea + bArea)
+
+-- Decide how much we like this rectangle.
+aspectBadness :: Rectangle -> Window -> Params -> Double
+aspectBadness rect win params =
+        (if a < 1 then tall else wide) * sqrt(w * h)
+    where
+        tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a
+        wide = if w < 700 then a else (a * w / 700)
+        a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params)
+        w = fromIntegral $ rect_width rect
+        h = fromIntegral $ rect_height rect
+
+-- vim: sw=4:et

XMonad/Layout/MultiToggle.hs

@@ -0,0 +1,235 @@
+{-# 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 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
+
+    pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s
+
+    doLayout mt r s = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (doLayout l r s)
+
+    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,47 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- 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(Named)
+                               ) where
+
+import XMonad
+
+-- $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"
+
+data Named l a = Named String (l a) deriving ( Read, Show )
+
+instance (LayoutClass l a) => LayoutClass (Named l) a where
+    doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s
+                                  return (ws, Named n `fmap` ml')
+    handleMessage (Named n l) mess = do ml' <- handleMessage l mess
+                                        return $ Named n `fmap` ml'
+    description (Named n _) = n

XMonad/Layout/NoBorders.hs

@@ -0,0 +1,96 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.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 XMonad.Layout.NoBorders (
+                                -- * Usage
+                                -- $usage
+                                noBorders,
+                                smartBorders,
+                                withBorder
+                               ) where
+
+import XMonad
+import XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet as W
+import Data.List ((\\))
+
+-- $usage
+-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Layout.NoBorders
+--
+-- and modify the layouts to call noBorders on the layouts you want to lack
+-- borders:
+--
+-- > layoutHook = ... ||| noBorders Full ||| ...
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+-- todo, use an InvisibleList.
+data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show )
+
+instance LayoutModifier WithBorder Window where
+    unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s
+
+    redoLayout (WithBorder n s) _ _ wrs = do
+        asks (borderWidth . config) >>= setBorders (s \\ ws)
+        setBorders ws n
+        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 :: [Window] -> Dimension -> X ()
+setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws
+
+data SmartBorder a = SmartBorder [a] deriving (Read, Show)
+
+instance LayoutModifier SmartBorder Window where
+    unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
+
+    redoLayout (SmartBorder s) _ _ wrs = do
+        ss <- gets (W.screens . windowset)
+
+        if singleton ws && singleton ss
+            then do
+                asks (borderWidth . config) >>= setBorders (s \\ ws)
+                setBorders ws 0
+                return (wrs, Just $ SmartBorder ws)
+            else do
+                asks (borderWidth . config) >>= setBorders s
+                return (wrs, Just $ SmartBorder [])
+     where
+        ws = map fst wrs
+        singleton = null . drop 1
+
+--
+-- | You can cleverly set no borders on a range of layouts, using a
+-- layoutHook like so:
+--
+-- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ...
+--
+smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a
+smartBorders = ModifiedLayout (SmartBorder [])

XMonad/Layout/PerWorkspace.hs

@@ -0,0 +1,145 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.PerWorkspace
+-- Copyright   :  (c) Brent Yorgey
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Configure layouts on a per-workspace basis.  NOTE that this module
+-- does not (yet) work in conjunction with multiple screens! =(
+--
+-- Note also that when using PerWorkspace, on initial startup workspaces
+-- may not respond to messages properly until a window has been opened.
+-- This is due to a limitation inherent in the way PerWorkspace is
+-- implemented: it cannot decide which layout to use until actually
+-- required to lay out some windows (which does not happen until a window
+-- is opened).
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.PerWorkspace (
+                                    -- * Usage
+                                    -- $usage
+
+                                    onWorkspace, onWorkspaces
+                                  ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import Data.Maybe (fromMaybe)
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Layout.PerWorkspace
+--
+-- and modifying your layoutHook as follows (for example):
+--
+-- > layoutHook = onWorkspace "foo" l1 $  -- layout l1 will be used on workspace "foo".
+-- >              onWorkspaces ["bar","6"] l2 $  -- layout l2 will be used on workspaces "bar" and "6".
+-- >              l3                      -- layout l3 will be used on all other workspaces.
+--
+-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts,
+-- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@
+--
+-- In another scenario, suppose you wanted to have layouts A, B, and C
+-- available on all workspaces, except that on workspace foo you want
+-- layout D instead of C.  You could do that as follows:
+--
+-- > layoutHook = A ||| B ||| onWorkspace "foo" D C
+--
+-- NOTE that this module does not (yet) work in conjunction with
+-- multiple screens. =(
+
+-- | Specify one layout to use on a particular workspace, and another
+--   to use on all others.  The second layout can be another call to
+--   'onWorkspace', and so on.
+onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)
+               => WorkspaceId -- ^ the tag of the workspace to match
+               -> (l1 a)      -- ^ layout to use on the matched workspace
+               -> (l2 a)      -- ^ layout to use everywhere else
+               -> PerWorkspace l1 l2 a
+onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2
+
+-- | Specify one layout to use on a particular set of workspaces, and
+--   another to use on all other workspaces.
+onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)
+                => [WorkspaceId]  -- ^ tags of workspaces to match
+                -> (l1 a)         -- ^ layout to use on matched workspaces
+                -> (l2 a)         -- ^ layout to use everywhere else
+                -> PerWorkspace l1 l2 a
+onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2
+
+-- | Structure for representing a workspace-specific layout along with
+--   a layout for all other workspaces.  We store the tags of workspaces
+--   to be matched, and the two layouts.  Since layouts are stored\/tracked
+--   per workspace, once we figure out whether we're on a matched workspace,
+--   we can cache that information using a (Maybe Bool).  This is necessary
+--   to be able to correctly implement the 'description' method of
+--   LayoutClass, since a call to description is not able to query the
+--   WM state to find out which workspace it was called in.
+data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]
+                                         (Maybe Bool)
+                                         (l1 a)
+                                         (l2 a)
+    deriving (Read, Show)
+
+instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where
+
+    -- do layout with l1, then return a modified PerWorkspace caching
+    --   the fact that we're in the matched workspace.
+    doLayout p@(PerWorkspace _ (Just True) lt _) r s = do
+        (wrs, mlt') <- doLayout lt r s
+        return (wrs, Just $ mkNewPerWorkspaceT p mlt')
+
+    -- do layout with l1, then return a modified PerWorkspace caching
+    --   the fact that we're not in the matched workspace.
+    doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do
+        (wrs, mlf') <- doLayout lf r s
+        return (wrs, Just $ mkNewPerWorkspaceF p mlf')
+
+    -- figure out which layout to use based on the current workspace.
+    doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do
+        t <- getCurrentTag
+        doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s
+
+    -- handle messages; same drill as doLayout.
+    handleMessage p@(PerWorkspace _ (Just True) lt _) m = do
+        mlt' <- handleMessage lt m
+        return . Just $ mkNewPerWorkspaceT p mlt'
+
+    handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do
+        mlf' <- handleMessage lf m
+        return . Just $ mkNewPerWorkspaceF p mlf'
+
+    handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing
+
+    description (PerWorkspace _ (Just True ) l1 _) = description l1
+    description (PerWorkspace _ (Just False) _ l2) = description l2
+
+    -- description's result is not in the X monad, so we have to wait
+    -- until a doLayout for the information about which workspace
+    -- we're in to get cached.
+    description _ = "PerWorkspace"
+
+-- | Construct new PerWorkspace values with possibly modified layouts.
+mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->
+                      PerWorkspace l1 l2 a
+mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' =
+    (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt'
+
+mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->
+                      PerWorkspace l1 l2 a
+mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' =
+    (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf'
+
+-- | Get the tag of the currently active workspace.  Note that this
+--   is only guaranteed to be the same workspace for which doLayout
+--   was called if there is only one screen.
+getCurrentTag :: X WorkspaceId
+getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current

XMonad/Layout/Reflect.hs

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

XMonad/Layout/ResizableTile.hs

@@ -0,0 +1,104 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.ResizableTile
+-- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- More useful tiled layout that allows you to change a width\/height of window.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.ResizableTile (
+                                    -- * Usage
+                                    -- $usage
+                                    ResizableTall(..), MirrorResize(..)
+                                   ) where
+
+import XMonad hiding (splitVertically, splitHorizontallyBy)
+import qualified XMonad.StackSet as W
+import Control.Monad
+import qualified Data.Map as M
+import Data.List ((\\))
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.ResizableTile
+--
+-- Then edit your @layoutHook@ by adding the ResizableTile layout:
+--
+-- > myLayouts =  ResizableTall 1 (3/100) (1/2) [] ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You may also want to add the following key bindings:
+--
+-- > , ((modMask x,               xK_a), sendMessage MirrorShrink)
+-- > , ((modMask x,               xK_z), sendMessage MirrorExpand)
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable
+instance Message MirrorResize
+
+data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read)
+instance LayoutClass ResizableTall a where
+    doLayout (ResizableTall nmaster _ frac mfrac) r =
+        return . (\x->(x,Nothing)) .
+        ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate
+    handleMessage (ResizableTall nmaster delta frac mfrac) m =
+        do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+           fs <- (M.keys . W.floating) `fmap` gets windowset
+           return $ ms >>= unfloat fs >>= handleMesg
+        where handleMesg s = msum [fmap resize (fromMessage m)
+                                  ,fmap (\x -> mresize x s) (fromMessage m)
+                                  ,fmap incmastern (fromMessage m)]
+              unfloat fs s = if W.focus s `elem` fs
+                               then Nothing
+                               else Just (s { W.up = (W.up s) \\ fs
+                                            , W.down = (W.down s) \\ fs })
+              resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac
+              resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac
+              mresize MirrorShrink s = mresize' s delta
+              mresize MirrorExpand s = mresize' s (0-delta)
+              mresize' s d = let n = length $ W.up s
+                                 total = n + (length $ W.down s) + 1
+                                 pos = if n == (nmaster-1) || n == (total-1) then n-1 else n
+                                 mfrac' = modifymfrac (mfrac ++ repeat 1) d pos
+                             in ResizableTall nmaster delta frac $ take total mfrac'
+              modifymfrac [] _ _ = []
+              modifymfrac (f:fx) d n | n == 0    = f+d : fx
+                                     | otherwise = f : modifymfrac fx d (n-1)
+              incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac
+    description _ = "ResizableTall"
+
+tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]
+tile f mf r nmaster n = if n <= nmaster || nmaster == 0
+    then splitVertically mf n r
+    else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns
+  where (r1,r2) = splitHorizontallyBy f r
+
+splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]
+splitVertically [] _ r = [r]
+splitVertically _ n r | n < 2 = [r]
+splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
+    splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
+  where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map.
+
+splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
+splitHorizontallyBy f (Rectangle sx sy sw sh) =
+    ( Rectangle sx sy leftw sh
+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
+  where leftw = floor $ fromIntegral sw * f

XMonad/Layout/Roledex.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Roledex
+-- Module      :  XMonad.Layout.Roledex
 -- Copyright   :  (c) tim.thelion@gmail.com
 -- License     :  BSD
 --
@@ -10,30 +12,38 @@
 --
 -- Screenshot  :  <http://www.timthelion.com/rolodex.png>
 --
--- This is a compleatly pointless layout which acts like Microsoft's Flip 3D
+-- This is a completely pointless layout which acts like Microsoft's Flip 3D
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Roledex (
+module XMonad.Layout.Roledex (
     -- * Usage
     -- $usage
-    roledex) where
+    Roledex(Roledex)) where
 
 import XMonad
-import Operations
-import qualified StackSet as W
-import Graphics.X11.Xlib
+import qualified XMonad.StackSet as W
 import Data.Ratio
-import XMonadContrib.LayoutHelpers ( idModify )
 
 -- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
--- > import XMonadContrib.Roledex 
--- > defaultLayouts = [ roledex ]
+-- > import XMonad.Layout.Roledex 
+--
+-- Then edit your @layoutHook@ by adding the Roledex layout:
+--
+-- > myLayouts =  Roledex ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-roledex :: Eq a => Layout a
-roledex = Layout { doLayout = roledexLayout, modifyLayout = idModify }
+data Roledex a = Roledex deriving ( Show, Read )
 
-roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
+instance LayoutClass Roledex Window where
+    doLayout _ = roledexLayout
+
+roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a))
 roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++
                               (zip ups tops) ++
                               (reverse (zip dns bottoms))
@@ -41,7 +51,7 @@ roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++
  where ups    = W.up ws
        dns    = W.down ws
        c = length ups + length dns
-       rect = fst $ splitHorizontallyBy (2% 3) $ fst (splitVerticallyBy (2% 3) sc) 
+       rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) 
        gw = div' (w - rw) (fromIntegral c) 
             where
             (Rectangle _ _ w _) = sc
@@ -59,5 +69,6 @@ roledexLayout sc ws = return ([(W.focus ws, mainPane)] ++
                 then (n - 1) : (cd (n-1) m)
                 else []
 
+div' :: Integral a => a -> a -> a
 div' _ 0 = 0
 div' n o = div n o

XMonad/Layout/ShowWName.hs

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

XMonad/Layout/Spiral.hs

@@ -1,9 +1,11 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Spiral
+-- Module      :  XMonad.Layout.Spiral
 -- Copyright   :  (c) Joe Thornber <joe.thornber@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  Joe Thornber <joe.thornber@gmail.com>
 -- Stability   :  stable
 -- Portability :  portable
@@ -12,7 +14,7 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Spiral (
+module XMonad.Layout.Spiral (
                              -- * Usage
                              -- $usage
                              spiral
@@ -21,33 +23,34 @@ module XMonadContrib.Spiral (
                             , Direction (..)
                             ) where
 
-import Graphics.X11.Xlib
-import Operations
 import Data.Ratio
 import XMonad
-
-import XMonadContrib.LayoutHelpers
+import XMonad.StackSet ( integrate )
 
 -- $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.Spiral
+-- > import XMonad.Layout.Spiral
+-- > import Data.Ratio
 --
--- >   defaultLayouts :: [Layout]
--- >   defaultLayouts = [ full,
--- >                      tall defaultWindowsInMaster defaultDelta (1%2),
--- >                      wide defaultWindowsInMaster defaultDelta (1%2),
--- >                      spiral (1 % 1) ]
+-- Then edit your @layoutHook@ by adding the Spiral layout:
+--
+-- > myLayouts =  spiral (1 % 1) ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
 fibs :: [Integer]
-fibs = 1 : 1 : (zipWith (+) fibs (tail fibs))
+fibs = 1 : 1 : zipWith (+) fibs (tail fibs)
 
 mkRatios :: [Integer] -> [Rational]
 mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs)
 mkRatios _ = []
 
-data Rotation = CW | CCW
-data Direction = East | South | West | North deriving (Eq, Enum)
+data Rotation = CW | CCW deriving (Read, Show)
+data Direction = East | South | West | North deriving (Eq, Enum, Read, Show)
 
 blend :: Rational -> [Rational] -> [Rational]
 blend scale ratios = zipWith (+) ratios scaleFactors
@@ -56,21 +59,27 @@ blend scale ratios = zipWith (+) ratios scaleFactors
       step = (scale - (1 % 1)) / (fromIntegral len)
       scaleFactors = map (* step) . reverse . take len $ [0..]
 
-spiral :: Rational -> Layout a
+spiral :: Rational -> SpiralWithDir a
 spiral = spiralWithDir East CW
 
-spiralWithDir :: Direction -> Rotation -> Rational -> Layout a
-spiralWithDir dir rot scale = Layout { doLayout = l2lModDo fibLayout,
-                                       modifyLayout = \m -> return $ fmap resize $ fromMessage m }
-    where
-      fibLayout sc ws = zip ws rects
-          where ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs
-                rects = divideRects (zip ratios dirs) sc
-                dirs  = dropWhile (/= dir) $ case rot of
-                                               CW  -> cycle [East .. North] 
-                                               CCW -> cycle [North, West, South, East]
-      resize Expand = spiralWithDir dir rot $ (21 % 20) * scale
-      resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale
+spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a
+spiralWithDir = SpiralWithDir
+
+data SpiralWithDir a = SpiralWithDir Direction Rotation Rational
+                     deriving ( Read, Show )
+
+instance LayoutClass SpiralWithDir a where
+    pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects
+        where ws = integrate stack
+              ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs
+              rects = divideRects (zip ratios dirs) sc
+              dirs  = dropWhile (/= dir) $ case rot of
+                                           CW  -> cycle [East .. North]
+                                           CCW -> cycle [North, West, South, East]
+    handleMessage (SpiralWithDir dir rot scale) = return . fmap resize . fromMessage
+        where resize Expand = spiralWithDir dir rot $ (21 % 20) * scale
+              resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale
+    description _ = "Spiral"
 
 -- This will produce one more rectangle than there are splits details
 divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle]

XMonad/Layout/Square.hs

@@ -1,49 +1,54 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.Square
+-- Module      :  XMonad.Layout.Square
 -- Copyright   :  (c) David Roundy <droundy@darcs.net>
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  David Roundy <droundy@darcs.net>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- A layout that splits the screen into a square area and the rest of the
 -- screen.
--- This is probably only ever useful in combination with 
--- "XMonadContrib.Combo".
+-- This is probably only ever useful in combination with
+-- "XMonad.Layout.Combo".
 -- It sticks one window in a square region, and makes the rest
 -- of the windows live with what's left (in a full-screen sense).
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.Square (
+module XMonad.Layout.Square (
                              -- * Usage
                              -- $usage
-                             square ) where
+                             Square(..) ) where
 
 import XMonad
-import Graphics.X11.Xlib
-import XMonadContrib.LayoutHelpers ( l2lModDo, idModify )
+import XMonad.StackSet ( integrate )
 
 -- $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@ file:
 --
--- >   import XMonadContrib.Square
+-- >   import XMonad.Layout.Square
 --
--- An example layout using square together with "XMonadContrib.Combo"
+-- An example layout using square together with "XMonad.Layout.Combo"
 -- to make the very last area square:
 --
 -- > , combo (combo (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) )
 -- >                [(twoPane 0.03 0.2,1),(combo [(twoPane 0.03 0.8,1),(square,1)]
 -- >         [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)]
 
-square :: Layout a
-square = Layout { doLayout = l2lModDo arrange, modifyLayout = idModify }
- where arrange :: Rectangle -> [a] -> [(a, Rectangle)]
-       arrange rect ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]
-                 where (rest, sq) = splitSquare rect
-       arrange _ [] = []
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data Square a = Square deriving ( Read, Show )
+
+instance LayoutClass Square a where
+    pureLayout Square r s = arrange (integrate s)
+        where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]
+              arrange [] = [] -- actually, this is an impossible case
+              (rest, sq) = splitSquare r
 
 splitSquare :: Rectangle -> (Rectangle, Rectangle)
 splitSquare (Rectangle x y w h)

XMonad/Layout/Tabbed.hs

@@ -0,0 +1,240 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.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 XMonad.Layout.Tabbed (
+                             -- * Usage:
+                             -- $usage
+                             tabbed
+                            , shrinkText, CustomShrink(CustomShrink)
+                            , TConf (..), defaultTConf
+                            , Shrinker(..)
+                            ) where
+
+import Data.Maybe
+import Data.List
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Util.NamedWindows
+import XMonad.Util.Invisible
+import XMonad.Util.XUtils
+import XMonad.Util.Font
+
+import XMonad.Hooks.UrgencyHook
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.Tabbed
+--
+-- Then edit your @layoutHook@ by adding the Tabbed layout:
+--
+-- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- You can also edit the default configuration options.
+--
+-- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000"
+-- >                            , activeTextColor = "#00FF00"}
+--
+-- and
+--
+-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..
+
+tabbed :: Shrinker s => s -> TConf -> Tabbed s a
+tabbed s t = Tabbed (I Nothing) s t
+
+data TConf =
+    TConf { activeColor         :: String
+          , inactiveColor       :: String
+          , urgentColor         :: String
+          , activeBorderColor   :: String
+          , inactiveBorderColor :: String
+          , urgentBorderColor   :: String
+          , activeTextColor     :: String
+          , inactiveTextColor   :: String
+          , urgentTextColor     :: String
+          , fontName            :: String
+          , tabSize             :: Int
+          } deriving (Show, Read)
+
+defaultTConf :: TConf
+defaultTConf =
+    TConf { activeColor         = "#999999"
+          , inactiveColor       = "#666666"
+          , urgentColor         = "#FFFF00"
+          , activeBorderColor   = "#FFFFFF"
+          , inactiveBorderColor = "#BBBBBB"
+          , urgentBorderColor   = "##00FF00"
+          , activeTextColor     = "#FFFFFF"
+          , inactiveTextColor   = "#BFBFBF"
+          , urgentTextColor     = "#FF0000"
+          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
+          , tabSize             = 20
+          }
+
+data TabState =
+    TabState { tabsWindows :: [(Window,Window)]
+             , scr         :: Rectangle
+             , font        :: XMonadFont
+             }
+
+data Tabbed s a =
+    Tabbed (Invisible Maybe TabState) s TConf
+    deriving (Show, Read)
+
+instance Shrinker s => LayoutClass (Tabbed s) Window where
+    doLayout (Tabbed ist ishr conf) = doLay ist ishr conf
+    handleMessage                   = handleMess
+    description _                   = "Tabbed"
+
+doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf
+      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window))
+doLay ist ishr c sc (W.Stack w [] []) = do
+  whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st)
+  return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c)
+doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do
+  let ws = W.integrate s
+      width = wid `div` fromIntegral (length ws)
+  -- initialize state
+  st <- case ist of
+          (I Nothing  ) -> initState c sc ws
+          (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc
+                           then return ts
+                           else do mapM_ deleteWindow (map fst $ tabsWindows ts)
+                                   tws <- createTabs c sc ws
+                                   return (ts {scr = sc, tabsWindows = zip tws ws})
+  mapM_ showWindow $ map fst $ tabsWindows st
+  mapM_ (updateTab ishr c (font st) width) $ tabsWindows st
+  return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c))
+
+handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window))
+handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m
+    | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e     >> return Nothing
+    | Just Hide             == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing
+    | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws
+                                                  releaseXMF (font st)
+                                                  return $ Just $ Tabbed (I Nothing) ishr conf
+handleMess _ _  = return Nothing
+
+handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X ()
+-- button press
+handleEvent ishr conf (TabState    {tabsWindows = tws,   scr          = screen, font          = fs})
+                      (ButtonEvent {ev_window   = thisw, ev_subwindow = thisbw, ev_event_type = t })
+    | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl  = do
+  case lookup thisw tws of
+    Just x  -> do focus x
+                  updateTab ishr conf fs width (thisw, x)
+    Nothing -> return ()
+    where
+      width = rect_width screen`div` fromIntegral (length tws)
+
+handleEvent ishr conf (TabState {tabsWindows = tws,   scr           = screen, font = fs})
+                      (AnyEvent {ev_window   = thisw, ev_event_type = t                })
+-- expose
+    | thisw `elem` (map fst tws) && t == expose         = do
+  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)
+    where
+      width = rect_width screen`div` fromIntegral (length tws)
+
+-- propertyNotify
+handleEvent ishr conf (TabState      {tabsWindows = tws, scr = screen, font = fs})
+                      (PropertyEvent {ev_window   = thisw})
+    | thisw `elem` (map snd tws) = do
+  let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw)
+  updateTab ishr conf fs width tabwin
+    where width = rect_width screen `div` fromIntegral (length tws)
+-- expose
+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs})
+                      (ExposeEvent {ev_window   = thisw})
+    | thisw `elem` (map fst tws) = do
+  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)
+    where width = rect_width screen `div` fromIntegral (length tws)
+handleEvent _ _ _ _ =  return ()
+
+initState :: TConf -> Rectangle -> [Window] -> X TabState
+initState conf sc ws = do
+  fs  <- initXMF (fontName conf)
+  tws <- createTabs conf sc ws
+  return $ TabState (zip tws ws) sc fs
+
+createTabs :: TConf -> Rectangle -> [Window] -> X [Window]
+createTabs _ _ [] = return []
+createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do
+  let wid    = wh `div` (fromIntegral $ length owl)
+      height = fromIntegral $ tabSize c
+      mask   = Just (exposureMask .|. buttonPressMask)
+  d  <- asks display
+  w  <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c) True
+  io $ restackWindows d $ w : [ow]
+  ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows
+  return (w:ws)
+
+updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X ()
+updateTab ishr c fs wh (tabw,ow) = do
+  nw <- getName ow
+  ur <- readUrgents
+  let ht                   = fromIntegral $ tabSize c :: Dimension
+      focusColor win ic ac uc = (maybe ic (\focusw -> case () of
+                                                       _ | focusw == win -> ac
+                                                         | win `elem` ur -> uc
+                                                         | otherwise     -> ic) . W.peek)
+                                `fmap` gets windowset
+  (bc',borderc',tc') <- focusColor ow
+                           (inactiveColor c, inactiveBorderColor c, inactiveTextColor c)
+                           (activeColor   c, activeBorderColor   c, activeTextColor   c)
+                           (urgentColor   c, urgentBorderColor   c, urgentTextColor   c)
+  dpy <- asks display
+  let s = shrinkIt ishr
+  name <- shrinkWhile s (\n -> do
+                                size <- io $ textWidthXMF dpy fs n
+                                return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
+  paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name
+
+shrink :: TConf -> Rectangle -> Rectangle
+shrink c (Rectangle x y w h) =
+    Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
+
+shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String
+shrinkWhile sh p x = sw $ sh x
+    where sw [n] = return n
+          sw [] = return ""
+          sw (n:ns) = do
+                        cond <- p n
+                        if cond
+                          then sw ns
+                          else return n
+
+data CustomShrink = CustomShrink
+instance Show CustomShrink where show _ = ""
+instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)]
+
+class (Read s, Show s) => Shrinker s where
+    shrinkIt :: s -> String -> [String]
+
+data DefaultShrinker = DefaultShrinker
+instance Show DefaultShrinker where show _ = ""
+instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)]
+instance Shrinker DefaultShrinker where
+    shrinkIt _ "" = [""]
+    shrinkIt s cs = cs : shrinkIt s (init cs)
+
+shrinkText :: DefaultShrinker
+shrinkText = DefaultShrinker

XMonad/Layout/ThreeColumns.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.ThreeColumns
+-- Module      :  XMonad.Layout.ThreeColumns
 -- Copyright   :  (c) Kai Grossjohann <kai@emptydomain.de>
 -- License     :  BSD3-style (see LICENSE)
 -- 
@@ -12,43 +14,48 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.ThreeColumns (
+module XMonad.Layout.ThreeColumns (
                               -- * Usage
                               -- $usage
-                              threeCol
+                              ThreeCol(..)
                              ) where
 
 import XMonad
-import qualified StackSet as W
-import Operations ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy )
+import qualified XMonad.StackSet as W
 
 import Data.Ratio
 
---import Control.Monad.State
-import Control.Monad.Reader
-
-import Graphics.X11.Xlib
+import Control.Monad
 
 -- $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.ThreeColumns
 --
--- > import XMonadContrib.ThreeColumns
+-- Then edit your @layoutHook@ by adding the ThreeCol layout:
 --
---  and add, to the list of layouts:
+-- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayouts }
 --
--- > threeCol
+-- Use @True@ as the last argument to get a wide layout.
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
 
-threeCol :: Int -> Rational -> Rational -> Layout a
-threeCol nmaster delta frac =
-    Layout { doLayout     = \r -> return . (\x->(x,Nothing)) .
-                                  ap zip (tile3 frac r nmaster . length) . W.integrate
-           , modifyLayout = \m -> return $ msum [fmap resize     (fromMessage m)
-                                                ,fmap incmastern (fromMessage m)] }
+data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read)
 
-    where resize Shrink = threeCol nmaster delta (max 0 $ frac-delta)
-          resize Expand = threeCol nmaster delta (min 1 $ frac+delta)
-          incmastern (IncMasterN d) = threeCol (max 0 (nmaster+d)) delta frac
+instance LayoutClass ThreeCol a where
+    doLayout (ThreeCol nmaster _ frac) r =
+        return . (\x->(x,Nothing)) .
+        ap zip (tile3 frac r nmaster . length) . W.integrate
+    handleMessage (ThreeCol nmaster delta frac) m =
+        return $ msum [fmap resize     (fromMessage m)
+                      ,fmap incmastern (fromMessage m)]
+            where resize Shrink = ThreeCol nmaster delta (max 0 $ frac-delta)
+                  resize Expand = ThreeCol nmaster delta (min 1 $ frac+delta)
+                  incmastern (IncMasterN d) = ThreeCol (max 0 (nmaster+d)) delta frac
+    description _ = "ThreeCol"
 
 -- | tile3.  Compute window positions using 3 panes
 tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]