Export types to improve haddock links.

Added new messages the layout understands to allow changing the grid aspect
ratio and setting the fraction of the master to a given value rather than
changing it relative to the current value.

XMonad/Actions/CopyWindow.hs

@@ -26,7 +26,6 @@ module XMonad.Actions.CopyWindow (
 
 import XMonad
 import Control.Arrow ((&&&))
-import Control.Monad
 import qualified Data.List as L
 
 import XMonad.Actions.WindowGo
@@ -146,7 +145,9 @@ killAllOtherCopies = do ss <- gets windowset
       delFromAllButCurrent w ss = foldr ($) ss $
                                   map (delWinFromWorkspace w . W.tag) $
                                   W.hidden ss ++ map W.workspace (W.visible ss)
-      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid
+      delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
+
+      viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
 
 -- | A list of hidden workspaces containing a copy of the focused window.
 wsContainingCopies :: X [WorkspaceId]

XMonad/Actions/CycleWS.hs

@@ -46,6 +46,7 @@ module XMonad.Actions.CycleWS (
                                 -- * Toggling the previous workspace
                                 -- $toggling
                               , toggleWS
+                              , toggleWS'
                               , toggleOrView
 
                                 -- * Moving between screens (xinerama)
@@ -65,6 +66,7 @@ module XMonad.Actions.CycleWS (
 
                               , shiftTo
                               , moveTo
+                              , doTo
 
                                 -- * The mother-combinator
 
@@ -72,6 +74,8 @@ module XMonad.Actions.CycleWS (
                               , toggleOrDoSkip
                               , skipTags
 
+                              , screenBy
+
                              ) where
 
 import Control.Monad ( unless )
@@ -147,9 +151,16 @@ shiftToPrev = shiftBy (-1)
 
 -- | Toggle to the workspace displayed previously.
 toggleWS :: X ()
-toggleWS = do
-    hs <- gets (hidden . windowset)
-    unless (null hs) (windows . view . tag $ head hs)
+toggleWS = toggleWS' []
+
+-- | Toggle to the previous workspace while excluding some workspaces.
+--
+-- > -- Ignore the scratchpad workspace while toggling:
+-- > ("M-b", toggleWS' ["NSP"])
+toggleWS' :: [WorkspaceId] -> X ()
+toggleWS' skips = do
+    hs' <- cleanHiddens skips
+    unless (null hs') (windows . view . tag $ head hs')
 
 -- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view
 -- the previously displayed workspace ala weechat. Change @greedyView@ to
@@ -159,9 +170,8 @@ toggleWS = do
 toggleOrView :: WorkspaceId -> X ()
 toggleOrView = toggleOrDoSkip [] greedyView
 
--- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while
--- finding the previously displayed workspace, or choice of different actions,
--- like view, shift, etc.  For example:
+-- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\"), and
+-- running other actions such as view, shift, etc.  For example:
 --
 -- > import qualified XMonad.StackSet as W
 -- > import XMonad.Actions.CycleWS
@@ -174,9 +184,9 @@ toggleOrView = toggleOrDoSkip [] greedyView
 toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
                                   -> WorkspaceId -> X ()
 toggleOrDoSkip skips f toWS = do
-    ws <- gets windowset
-    let hs' = hidden ws `skipTags` skips
-    if toWS == (tag . workspace $ current ws)
+    hs' <- cleanHiddens skips
+    cur <- gets (currentTag . windowset)
+    if toWS == cur
         then unless (null hs') (windows . f . tag $ head hs')
         else windows (f toWS)
 
@@ -185,6 +195,9 @@ toggleOrDoSkip skips f toWS = do
 skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a]
 skipTags wss ids = filter ((`notElem` ids) . tag) wss
 
+cleanHiddens :: [WorkspaceId] -> X [WindowSpace]
+cleanHiddens skips =  gets $ (flip skipTags) skips . hidden . windowset
+
 switchWorkspace :: Int -> X ()
 switchWorkspace d = wsBy d >>= windows . greedyView
 
@@ -244,12 +257,17 @@ wsTypeToPred (WSIs p)   = p
 -- | View the next workspace in the given direction that satisfies
 --   the given condition.
 moveTo :: Direction1D -> WSType -> X ()
-moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
+moveTo dir t = doTo dir t getSortByIndex (windows . greedyView)
 
 -- | Move the currently focused window to the next workspace in the
 --   given direction that satisfies the given condition.
 shiftTo :: Direction1D -> WSType -> X ()
-shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
+shiftTo dir t = doTo dir t getSortByIndex (windows . shift)
+
+-- | Using the given sort, find the next workspace in the given
+-- direction of the given type, and perform the given action on it.
+doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
+doTo dir t srt act = findWorkspace srt dir t 1 >>= act
 
 -- | Given a function @s@ to sort workspaces, a direction @dir@, a
 --   predicate @p@ on workspaces, and an integer @n@, find the tag of
@@ -307,6 +325,17 @@ switchScreen d = do s <- screenBy d
                          Nothing -> return ()
                          Just ws -> windows (view ws)
 
+{- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the
+the default screen keybindings:
+
+>     -- mod-{w,e}, Switch to previous/next Xinerama screen
+>     -- mod-shift-{w,e}, Move client to previous/next Xinerama screen
+>     --
+>     [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f))
+>         | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)]
+>         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
+-}
 screenBy :: Int -> X (ScreenId)
 screenBy d = do ws <- gets windowset
                 --let ss = sortBy screen (screens ws)

XMonad/Actions/CycleWindows.hs

@@ -226,8 +226,10 @@ rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwis
            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
 
 -- $generic
--- Generic list rotations
+-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
+-- @id@ for null or singleton lists.
 rotUp :: [a] -> [a]
-rotUp   l = tail l ++ [head l]
+rotUp   l = drop 1 l ++ take 1 l
 rotDown :: [a] -> [a]
-rotDown l = last l : init l
+rotDown = reverse . rotUp . reverse

XMonad/Actions/DynamicWorkspaceGroups.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceGroups
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Dynamically manage \"workspace groups\", sets of workspaces being
+-- used together for some common task or purpose, to allow switching
+-- between workspace groups in a single action.  Note that this only
+-- makes sense for multi-head setups.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceGroups
+    ( -- * Usage
+      -- $usage
+
+      WSGroupId
+
+    , addWSGroup
+    , addCurrentWSGroup
+    , forgetWSGroup
+    , viewWSGroup
+
+    , promptWSGroupView
+    , promptWSGroupAdd
+    , promptWSGroupForget
+
+    , WSGPrompt
+    ) where
+
+import Data.List (find)
+import Control.Arrow ((&&&))
+import qualified Data.Map as M
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Prompt
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Actions.DynamicWorkspaceGroups
+--
+-- Then add keybindings like the following (this example uses
+-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
+--
+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
+-- >    , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
+--
+
+type WSGroup = [(ScreenId,WorkspaceId)]
+
+type WSGroupId = String
+
+data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
+  deriving (Typeable, Read, Show)
+
+withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
+withWSG f = WSG . f . unWSG
+
+instance ExtensionClass WSGroupStorage where
+  initialValue = WSG $ M.empty
+  extensionType = PersistentExtension
+
+-- | Add a new workspace group with the given name.
+addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
+addWSGroup name wids = withWindowSet $ \w -> do
+  let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
+      wmap = mapM (strength . (flip lookup wss &&& id)) wids
+  case wmap of
+    Just ps -> XS.modify . withWSG . M.insert name $ ps
+    Nothing -> return ()
+ where strength (ma, b) = ma >>= \a -> return (a,b)
+
+-- | Give a name to the current workspace group.
+addCurrentWSGroup :: WSGroupId -> X ()
+addCurrentWSGroup name = withWindowSet $ \w ->
+  addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)
+
+-- | Delete the named workspace group from the list of workspace
+--   groups.  Note that this has no effect on the workspaces involved;
+--   it simply forgets the given name.
+forgetWSGroup :: WSGroupId -> X ()
+forgetWSGroup = XS.modify . withWSG . M.delete
+
+-- | View the workspace group with the given name.
+viewWSGroup :: WSGroupId -> X ()
+viewWSGroup name = do
+  WSG m <- XS.get
+  case M.lookup name m of
+    Just grp -> mapM_ (uncurry viewWS) grp
+    Nothing -> return ()
+
+-- | View the given workspace on the given screen.
+viewWS :: ScreenId -> WorkspaceId -> X ()
+viewWS sid wid = do
+  mw <- findScreenWS sid
+  case mw of
+    Just w -> do
+      windows $ W.view w
+      windows $ W.greedyView wid
+    Nothing -> return ()
+
+-- | Find the workspace which is currently on the given screen.
+findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
+findScreenWS sid = withWindowSet $
+  return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
+
+data WSGPrompt = WSGPrompt String
+
+instance XPrompt WSGPrompt where
+  showXPrompt (WSGPrompt s) = s
+
+-- | Prompt for a workspace group to view.
+promptWSGroupView :: XPConfig -> String -> X ()
+promptWSGroupView xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
+
+-- | Prompt for a name for the current workspace group.
+promptWSGroupAdd :: XPConfig -> String -> X ()
+promptWSGroupAdd xp s =
+  mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup
+
+-- | Prompt for a workspace group to forget.
+promptWSGroupForget :: XPConfig -> String -> X ()
+promptWSGroupForget xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceOrder
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Remember a dynamically updateable ordering on workspaces, together
+-- with tools for using this ordering with "XMonad.Actions.CycleWS"
+-- and "XMonad.Hooks.DynamicLog".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceOrder
+    ( -- * Usage
+      -- $usage
+
+      getWsCompareByOrder
+    , getSortByOrder
+    , swapWith
+
+    , moveTo
+    , moveToGreedy
+    , shiftTo
+
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Ord (comparing)
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
+--
+-- Then add keybindings to swap the order of workspaces (these
+-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
+--
+-- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)
+-- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)
+--
+-- See "XMonad.Actions.CycleWS" for information on the possible
+-- arguments to 'swapWith'.
+--
+-- However, by itself this will do nothing; 'swapWith' does not change
+-- the actual workspaces in any way.  It simply keeps track of an
+-- auxiliary ordering on workspaces.  Anything which cares about the
+-- order of workspaces must be updated to use the auxiliary ordering.
+--
+-- To change the order in which workspaces are displayed by
+-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
+-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
+--
+-- >   ... dynamicLogWithPP $ byorgeyPP {
+-- >     ...
+-- >     , ppSort = DO.getSortByOrder
+-- >     ...
+-- >   }
+--
+-- To use workspace cycling commands like those from
+-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
+-- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:
+--
+-- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)
+-- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)
+-- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)
+-- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)
+--
+-- For slight variations on these, use the source for examples and
+-- tweak as desired.
+
+-- | Extensible state storage for the workspace order.
+data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
+  deriving (Typeable, Read, Show)
+
+instance ExtensionClass WSOrderStorage where
+  initialValue = WSO Nothing
+  extensionType = PersistentExtension
+
+-- | Lift a Map function to a function on WSOrderStorage.
+withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
+           -> (WSOrderStorage -> WSOrderStorage)
+withWSO f = WSO . fmap f . unWSO
+
+-- | Update the ordering storage: initialize if it doesn't yet exist;
+-- add newly created workspaces at the end as necessary.
+updateOrder :: X ()
+updateOrder = do
+  WSO mm <- XS.get
+  case mm of
+    Nothing -> do
+      -- initialize using ordering of workspaces from the user's config
+      ws <- asks (workspaces . config)
+      XS.put . WSO . Just . M.fromList $ zip ws [0..]
+    Just m -> do
+      -- check for new workspaces and add them at the end
+      curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)
+      let mappedWs  = M.keysSet m
+          newWs     = curWs `S.difference` mappedWs
+          nextIndex = 1 + maximum (-1 : M.elems m)
+          newWsIxs  = zip (S.toAscList newWs) [nextIndex..]
+      XS.modify . withWSO . M.union . M.fromList $ newWsIxs
+
+-- | A comparison function which orders workspaces according to the
+-- stored dynamic ordering.
+getWsCompareByOrder :: X WorkspaceCompare
+getWsCompareByOrder = do
+  updateOrder
+  -- after the call to updateOrder we are guaranteed that the dynamic
+  -- workspace order is initialized and contains all existing
+  -- workspaces.
+  WSO (Just m) <- XS.get
+  return $ comparing (fromMaybe 1000 . flip M.lookup m)
+
+-- | Sort workspaces according to the stored dynamic ordering.
+getSortByOrder :: X WorkspaceSort
+getSortByOrder = mkWsSort getWsCompareByOrder
+
+-- | Swap the current workspace with another workspace in the stored
+-- dynamic order.
+swapWith :: Direction1D -> WSType -> X ()
+swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent
+
+-- | Swap the given workspace with the current one.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent w = do
+  cur <- gets (W.currentTag . windowset)
+  swapOrder w cur
+
+-- | Swap the two given workspaces in the dynamic order.
+swapOrder :: WorkspaceId -> WorkspaceId -> X ()
+swapOrder w1 w2 = do
+  io $ print (w1,w2)
+  WSO (Just m) <- XS.get
+  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
+  XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
+  windows id  -- force a status bar update
+
+-- | View the next workspace of the given type in the given direction,
+-- where \"next\" is determined using the dynamic workspace order.
+moveTo :: Direction1D -> WSType -> X ()
+moveTo dir t = doTo dir t getSortByOrder (windows . W.view)
+
+-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
+moveToGreedy :: Direction1D -> WSType -> X ()
+moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
+
+-- | Shift the currently focused window to the next workspace of the
+-- given type in the given direction, using the dynamic workspace order.
+shiftTo :: Direction1D -> WSType -> X ()
+shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)

XMonad/Actions/DynamicWorkspaces.hs

@@ -28,8 +28,8 @@ module XMonad.Actions.DynamicWorkspaces (
 
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
-import XMonad.Prompt.Workspace
-import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
+import XMonad.Prompt ( XPConfig, mkXPrompt )
 import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 import Data.List (find)
 import Data.Maybe (isNothing)
@@ -39,6 +39,7 @@ import Control.Monad (when)
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.DynamicWorkspaces
+-- > import XMonad.Actions.CopyWindow(copy)
 --
 -- Then add keybindings like the following:
 --
@@ -56,14 +57,10 @@ import Control.Monad (when)
 -- >    zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
 --
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
+-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'defaultXPConfig'.
 
 
-data Wor = Wor String
-
-instance XPrompt Wor where
-    showXPrompt (Wor x) = x
-
 mkCompl :: [String] -> String -> IO [String]
 mkCompl l s = return $ filter (\x -> take (length s) x == s) l
 
@@ -153,7 +150,7 @@ removeEmptyWorkspaceAfter :: X () -> X ()
 removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
 
 -- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
---   whose entries will never be removed. 
+--   whose entries will never be removed.
 removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
 removeEmptyWorkspaceAfterExcept sticky f = do
     before <- gets (currentTag . windowset)

XMonad/Actions/FlexibleManipulate.hs

@@ -23,6 +23,8 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
+import qualified Prelude as P
+import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
 
 -- $usage
 -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@@ -84,7 +86,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
 
     let uv = (pointer - wpos) / wsize
         fc = mapP f uv
-        mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
+        mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
         atl = ((1, 1) - fc) * mul
         abr = fc * mul
     mouseDrag (\ex ey -> io $ do
@@ -121,14 +123,13 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
 minP :: Ord a => (a,a) -> (a,a) -> (a,a)
 minP = zipP min
 
-instance Num Pnt where
-    (+) = zipP (+)
-    (-) = zipP (-)
-    (*) = zipP (*)
-    abs = mapP abs
-    signum = mapP signum
-    fromInteger = const undefined
+infixl 6  +, -
+infixl 7  *, /
+
+(+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)
+(+) = zipP (P.+)
+(-) = zipP (P.-)
+(*) = zipP (P.*)
+(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
+(/) = zipP (P./)
 
-instance Fractional Pnt where
-    fromRational = const undefined
-    recip = mapP recip

XMonad/Actions/FlexibleResize.hs

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

XMonad/Actions/FloatKeys.hs

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

XMonad/Actions/GridSelect.hs

@@ -28,7 +28,6 @@ module XMonad.Actions.GridSelect (
     -- * Configuration
     GSConfig(..),
     defaultGSConfig,
-    NavigateMap,
     TwoDPosition,
     buildDefaultGSConfig,
 
@@ -46,13 +45,35 @@ module XMonad.Actions.GridSelect (
     HasColorizer(defaultColorizer),
     fromClassName,
     stringColorizer,
-    colorRangeFromClassName
+    colorRangeFromClassName,
+
+    -- * Navigation Mode assembly
+    TwoD,
+    makeXEventhandler,
+    shadowWithKeymap,
+
+    -- * Built-in Navigation Mode
+    defaultNavigation,
+    substringSearch,
+    navNSearch,
+
+    -- * Navigation Components
+    setPos,
+    move,
+    moveNext, movePrev,
+    select,
+    cancel,
+    transformSearchString,
 
     -- * Screenshots
     -- $screenshots
+
+    -- * Types
+    TwoDState,
     ) where
 import Data.Maybe
 import Data.Bits
+import Data.Char
 import Control.Applicative
 import Control.Monad.State
 import Control.Arrow
@@ -118,45 +139,48 @@ import Data.Word (Word8)
 
 -- $keybindings
 --
--- Adding more keybindings for gridselect to listen to is similar:
+-- You can build you own navigation mode and submodes by combining the
+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
 --
--- At the top of your config:
+-- > myNavigation :: TwoD a (Maybe a)
+-- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+-- >  where navKeyMap = M.fromList [
+-- >           ((0,xK_Escape), cancel)
+-- >          ,((0,xK_Return), select)
+-- >          ,((0,xK_slash) , substringSearch myNavigation)
+-- >          ,((0,xK_Left)  , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_h)     , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_Right) , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_l)     , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_Down)  , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_j)     , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_Up)    , move (0,-1)  >> myNavigation)
+-- >          ,((0,xK_y)     , move (-1,-1) >> myNavigation)
+-- >          ,((0,xK_i)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_n)     , move (-1,1)  >> myNavigation)
+-- >          ,((0,xK_m)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_space) , setPos (0,0) >> myNavigation)
+-- >          ]
+-- >        -- The navigation handler ignores unknown key symbols
+-- >        navDefaultHandler = const myNavigation
 --
--- > {-# LANGAUGE NoMonomorphismRestriction #-}
--- > import XMonad
--- > import qualified Data.Map as M
---
--- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
+-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
 --
 -- > gsconfig3 = defaultGSConfig
 -- >    { gs_cellheight = 30
 -- >    , gs_cellwidth = 100
--- >    , gs_navigate = M.unions
--- >            [reset
--- >            ,nethackKeys
--- >            ,gs_navigate                               -- get the default navigation bindings
--- >                $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable
--- >            ]
+-- >    , gs_navigate = myNavigation
 -- >    }
--- >   where addPair (a,b) (x,y) = (a+x,b+y)
--- >         nethackKeys = M.map addPair $ M.fromList
--- >                               [((0,xK_y),(-1,-1))
--- >                               ,((0,xK_i),(1,-1))
--- >                               ,((0,xK_n),(-1,1))
--- >                               ,((0,xK_m),(1,1))
--- >                               ]
--- >         -- jump back to the center with the spacebar, regardless of the current position.
--- >         reset = M.singleton (0,xK_space) (const (0,0))
 
 -- $screenshots
 --
 -- Selecting a workspace:
 --
--- <<http://haskell.org/sitewiki/images/a/a9/Xmonad-gridselect-workspace.png>>
+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
 --
 -- Selecting a window by title:
 --
--- <<http://haskell.org/sitewiki/images/3/35/Xmonad-gridselect-window-aavogt.png>>
+-- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>
 
 data GSConfig a = GSConfig {
       gs_cellheight :: Integer,
@@ -164,7 +188,7 @@ data GSConfig a = GSConfig {
       gs_cellpadding :: Integer,
       gs_colorizer :: a -> Bool -> X (String, String),
       gs_font :: String,
-      gs_navigate :: NavigateMap,
+      gs_navigate :: TwoD a (Maybe a),
       gs_originFractX :: Double,
       gs_originFractY :: Double
 }
@@ -194,21 +218,29 @@ instance HasColorizer a where
 defaultGSConfig :: HasColorizer a => GSConfig a
 defaultGSConfig = buildDefaultGSConfig defaultColorizer
 
-type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)
-
 type TwoDPosition = (Integer, Integer)
 
 type TwoDElementMap a = [(TwoDPosition,(String,a))]
 
 data TwoDState a = TwoDState { td_curpos :: TwoDPosition
-                             , td_elementmap :: TwoDElementMap a
+                             , td_availSlots :: [TwoDPosition]
+                             , td_elements :: [(String,a)]
                              , td_gsconfig :: GSConfig a
                              , td_font :: XMonadFont
                              , td_paneX :: Integer
                              , td_paneY :: Integer
                              , td_drawingWin :: Window
+                             , td_searchString :: String
                              }
 
+td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]
+td_elementmap s =
+  let positions = td_availSlots s
+      elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)
+  in zipWith (,) positions elements
+  where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]
+        upper = map toUpper
+
 newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
     deriving (Monad,Functor,MonadState (TwoDState a))
 
@@ -222,14 +254,16 @@ liftX = TwoD . lift
 evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
 evalTwoD m s = flip evalStateT s $ unTwoD m
 
-diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
--- FIXME remove nub
-diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
-        in nub $ ul ++ (map (negate *** id) ul) ++
-           (map (negate *** negate) ul) ++
-           (map (id *** negate) ul)
+diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]
+diamondLayer 0 = [(0,0)]
+diamondLayer n =
+  -- tr = top right
+  --  r = ur ++ 90 degree clock-wise rotation of ur
+  let tr = [ (x,n-x) | x <- [0..n-1] ]
+      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)
+  in r ++ (map (negate *** negate) r)
 
-diamond :: (Enum a, Num a) => [(a, a)]
+diamond :: (Enum a, Num a, Eq a) => [(a, a)]
 diamond = concatMap diamondLayer [0..]
 
 diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
@@ -266,11 +300,23 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
 updateAllElements :: TwoD a ()
 updateAllElements =
     do
-      TwoDState { td_elementmap = els } <- get
-      updateElements els
+      s <- get
+      updateElements (td_elementmap s)
+
+grayoutAllElements :: TwoD a ()
+grayoutAllElements =
+    do
+      s <- get
+      updateElementsWithColorizer grayOnly (td_elementmap s)
+    where grayOnly _ _ = return ("#808080", "#808080")
 
 updateElements :: TwoDElementMap a -> TwoD a ()
 updateElements elementmap = do
+      s <- get
+      updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap
+
+updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
+updateElementsWithColorizer colorizer elementmap = do
     TwoDState { td_curpos = curpos,
                 td_drawingWin = win,
                 td_gsconfig = gsconfig,
@@ -282,7 +328,7 @@ updateElements elementmap = do
         paneX' = div (paneX-cellwidth) 2
         paneY' = div (paneY-cellheight) 2
         updateElement (pos@(x,y),(text, element)) = liftX $ do
-            colors <- gs_colorizer gsconfig element (pos == curpos)
+            colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
                        cellheight
@@ -293,52 +339,180 @@ updateElements elementmap = do
                        (gs_cellpadding gsconfig)
     mapM_ updateElement elementmap
 
-eventLoop :: TwoD a (Maybe a)
-eventLoop = do
-  (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
-                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
-                             ev <- getEvent e
-                             (ks,s) <- if ev_event_type ev == keyPress
-                                       then lookupString $ asKeyEvent e
-                                       else return (Nothing, "")
-                             return (ks,s,ev)
-  handle (fromMaybe xK_VoidSymbol keysym,string) event
-
-handle ::  (KeySym, t) -> Event -> TwoD a (Maybe a)
-handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })
-    | t == keyPress && ks == xK_Escape = return Nothing
-    | t == keyPress && ks == xK_Return = do
-       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get
-       return $ fmap (snd . snd) $ findInElementMap pos elmap
-    | t == keyPress = do
-        m' <- liftX (cleanMask m)
-        keymap <- gets (gs_navigate . td_gsconfig)
-        maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap
-  where diffAndRefresh diff = do
-          state <- get
-          let elmap = td_elementmap state
-              oldPos = td_curpos state
-              newPos = diff oldPos
-              newSelectedEl = findInElementMap newPos elmap
-          when (isJust newSelectedEl) $ do
-                                put state { td_curpos =  newPos }
-                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
-          eventLoop
-
-handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })
+stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
+stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
     | t == buttonRelease = do
-        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,
-                     td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get
+        s @  TwoDState { td_paneX = px, td_paneY = py,
+                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) } <- get
         let gridX = (fi x - (px - cw) `div` 2) `div` cw
             gridY = (fi y - (py - ch) `div` 2) `div` ch
-        case lookup (gridX,gridY) elmap of
+        case lookup (gridX,gridY) (td_elementmap s) of
              Just (_,el) -> return (Just el)
-             Nothing -> eventLoop
-    | otherwise = eventLoop
+             Nothing -> contEventloop
+    | otherwise = contEventloop
 
-handle _ (ExposeEvent { }) = updateAllElements >> eventLoop
+stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
+
+stdHandle _ contEventloop = contEventloop
+
+-- | Embeds a key handler into the X event handler that dispatches key
+-- events to the key handler, while non-key event go to the standard
+-- handler.
+makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
+makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+                             ev <- getEvent e
+                             if ev_event_type ev == keyPress
+                               then do
+                                  (ks,s) <- lookupString $ asKeyEvent e
+                                  return $ do
+                                      mask <- liftX $ cleanMask (ev_state ev)
+                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)
+                               else
+                                  return $ stdHandle ev me
+
+-- | When the map contains (KeySym,KeyMask) tuple for the given event,
+-- the associated action in the map associated shadows the default key
+-- handler
+shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
+shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap)
+
+-- Helper functions to use for key handler functions
+
+-- | Closes gridselect returning the element under the cursor
+select :: TwoD a (Maybe a)
+select = do
+  s <- get
+  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+
+-- | Closes gridselect returning no element.
+cancel :: TwoD a (Maybe a)
+cancel = return Nothing
+
+-- | Sets the absolute position of the cursor.
+setPos :: (Integer, Integer) -> TwoD a ()
+setPos newPos = do
+  s <- get
+  let elmap = td_elementmap s
+      newSelectedEl = findInElementMap newPos (td_elementmap s)
+      oldPos = td_curpos s
+  when (isJust newSelectedEl && newPos /= oldPos) $ do
+    put s { td_curpos = newPos }
+    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+
+-- | Moves the cursor by the offsets specified
+move :: (Integer, Integer) -> TwoD a ()
+move (dx,dy) = do
+  s <- get
+  let (x,y) = td_curpos s
+      newPos = (x+dx,y+dy)
+  setPos newPos
+
+moveNext :: TwoD a ()
+moveNext = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just k | k == n-1 -> Just 0
+                      | otherwise -> Just (k+1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+movePrev :: TwoD a ()
+movePrev = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just 0  -> Just (n-1)
+               Just k  -> Just (k-1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+-- | Apply a transformation function the current search string
+transformSearchString :: (String -> String) -> TwoD a ()
+transformSearchString f = do
+          s <- get
+          let oldSearchString = td_searchString s
+              newSearchString = f oldSearchString
+          when (newSearchString /= oldSearchString) $ do
+            -- FIXME: grayoutAllElements + updateAllElements paint some fields twice causing flickering
+            --        we would need a much smarter update strategy to fix that
+            when (length newSearchString > length oldSearchString) grayoutAllElements
+            -- FIXME curpos might end up outside new bounds
+            put s { td_searchString = newSearchString }
+            updateAllElements
+
+-- | By default gridselect used the defaultNavigation action, which
+-- binds left,right,up,down and vi-style h,l,j,k navigation. Return
+-- quits gridselect, returning the selected element, while Escape
+-- cancels the selection. Slash enters the substring search mode. In
+-- substring search mode, every string-associated keystroke is
+-- added to a search string, which narrows down the object
+-- selection. Substring search mode comes back to regular navigation
+-- via Return, while Escape cancels the search. If you want that
+-- navigation style, add 'defaultNavigation' as 'gs_navigate' to your
+-- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.
+defaultNavigation :: TwoD a (Maybe a)
+defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+  where navKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_slash)      , substringSearch defaultNavigation)
+          ,((0,xK_Left)       , move (-1,0) >> defaultNavigation)
+          ,((0,xK_h)          , move (-1,0) >> defaultNavigation)
+          ,((0,xK_Right)      , move (1,0) >> defaultNavigation)
+          ,((0,xK_l)          , move (1,0) >> defaultNavigation)
+          ,((0,xK_Down)       , move (0,1) >> defaultNavigation)
+          ,((0,xK_j)          , move (0,1) >> defaultNavigation)
+          ,((0,xK_Up)         , move (0,-1) >> defaultNavigation)
+          ,((0,xK_k)          , move (0,-1) >> defaultNavigation)
+          ,((0,xK_Tab)        , moveNext >> defaultNavigation)
+          ,((0,xK_n)          , moveNext >> defaultNavigation)
+          ,((shiftMask,xK_Tab), movePrev >> defaultNavigation)
+          ,((0,xK_p)          , movePrev >> defaultNavigation)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navDefaultHandler = const defaultNavigation
+
+-- | This navigation style combines navigation and search into one mode at the cost of losing vi style
+-- navigation. With this style, there is no substring search submode,
+-- but every typed character is added to the substring search.
+navNSearch :: TwoD a (Maybe a)
+navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler
+  where navNSearchKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_Left)       , move (-1,0) >> navNSearch)
+          ,((0,xK_Right)      , move (1,0) >> navNSearch)
+          ,((0,xK_Down)       , move (0,1) >> navNSearch)
+          ,((0,xK_Up)         , move (0,-1) >> navNSearch)
+          ,((0,xK_Tab)        , moveNext >> navNSearch)
+          ,((shiftMask,xK_Tab), movePrev >> navNSearch)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navNSearchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          navNSearch
+
+-- | Navigation submode used for substring search. It returns to the
+-- first argument navigation style when the user hits Return.
+substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
+substringSearch returnNavigation = fix $ \me ->
+  let searchKeyMap = M.fromList [
+           ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)
+          ,((0,xK_Return)   , returnNavigation)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
+          ]
+      searchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          me
+  in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler
 
-handle _ _ = eventLoop
 
 -- FIXME probably move that into Utils?
 -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
@@ -417,7 +591,7 @@ stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
 -- select an element with cursors keys. The selected element is returned.
 gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
 gridselect _ [] = return Nothing
-gridselect gsconfig elmap =
+gridselect gsconfig elements =
  withDisplay $ \dpy -> do
     rootw <- asks theRoot
     s <- gets $ screenRect . W.screenDetail . W.current . windowset
@@ -437,16 +611,16 @@ gridselect gsconfig elmap =
                                 originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
                                 originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
                                 coords = diamondRestrict restrictX restrictY originPosX originPosY
-                                elmap' = zip coords elmap
 
-                            evalTwoD (updateAllElements >> eventLoop)
-                                (TwoDState (head coords)
-                                            elmap'
-                                            gsconfig
-                                            font
-                                            screenWidth
-                                            screenHeight
-                                            win)
+                            evalTwoD (updateAllElements >> (gs_navigate gsconfig)) TwoDState { td_curpos = (head coords),
+                                                                                  td_availSlots = coords,
+                                                                                  td_elements = elements,
+                                                                                  td_gsconfig = gsconfig,
+                                                                                  td_font = font,
+                                                                                  td_paneX = screenWidth,
+                                                                                  td_paneY = screenHeight,
+                                                                                  td_drawingWin = win,
+                                                                                  td_searchString = "" }
                       else
                           return Nothing
     liftIO $ do
@@ -483,19 +657,7 @@ decorateName' w = do
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)
-
-defaultGSNav :: NavigateMap
-defaultGSNav = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
-    [((0,xK_Left) ,(-1,0))
-    ,((0,xK_h)    ,(-1,0))
-    ,((0,xK_Right),(1,0))
-    ,((0,xK_l)    ,(1,0))
-    ,((0,xK_Down) ,(0,1))
-    ,((0,xK_j)    ,(0,1))
-    ,((0,xK_Up)   ,(0,-1))
-    ,((0,xK_k)    ,(0,-1))
-    ]
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation (1/2) (1/2)
 
 borderColor :: String
 borderColor = "white"
@@ -533,4 +695,4 @@ gridselectWorkspace :: GSConfig WorkspaceId ->
                           (WorkspaceId -> WindowSet -> WindowSet) -> X ()
 gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
     let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws)
-    gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)
+    gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)

XMonad/Actions/GroupNavigation.hs

@@ -0,0 +1,218 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Actions.GroupNavigation
+-- Copyright   : (c) nzeh@cs.dal.ca
+-- License     : BSD3-style (see LICENSE)
+--
+-- Maintainer  : nzeh@cs.dal.ca
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Provides methods for cycling through groups of windows across
+-- workspaces, ignoring windows that do not belong to this group.  A
+-- group consists of all windows matching a user-provided boolean
+-- query.
+--
+-- Also provides a method for jumping back to the most recently used
+-- window in any given group.
+--
+----------------------------------------------------------------------
+
+module XMonad.Actions.GroupNavigation ( -- * Usage  
+                                        -- $usage
+                                        Direction (..)
+                                      , nextMatch
+                                      , nextMatchOrDo
+                                      , nextMatchWithThis
+                                      , historyHook
+                                      ) where
+
+import Control.Monad.Reader
+import Data.Foldable as Fold
+import Data.Map as Map
+import Data.Sequence as Seq
+import Data.Set as Set
+import Graphics.X11.Types
+import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
+import XMonad.Core
+import XMonad.ManageHook
+import XMonad.Operations (windows, withFocused)
+import qualified XMonad.StackSet as SS
+import qualified XMonad.Util.ExtensibleState as XS
+
+{- $usage
+
+Import the module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions,GroupNavigation
+
+To support cycling forward and backward through all xterm windows, add
+something like this to your keybindings:
+
+> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
+> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))
+
+These key combinations do nothing if there is no xterm window open.
+If you rather want to open a new xterm window if there is no open
+xterm window, use 'nextMatchOrDo' instead:
+
+> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
+> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))
+
+You can use 'nextMatchWithThis' with an arbitrary query to cycle
+through all windows for which this query returns the same value as the
+current window.  For example, to cycle through all windows in the same
+window class as the current window use:
+
+> , ((modm , xK_f), nextMatchWithThis Forward  className)
+> , ((modm , xK_b), nextMatchWithThis Backward className)
+
+Finally, you can define keybindings to jump to the most recent window
+matching a certain Boolean query.  To do this, you need to add
+'historyHook' to your logHook:
+
+> main = xmonad $ defaultConfig { logHook = historyHook }
+
+Then the following keybindings, for example, allow you to return to
+the most recent xterm or emacs window or to simply to the most recent
+window:
+
+> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
+> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
+> , ((modm                , xK_BackSpace), nextMatch History (return True))
+
+Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
+to execute an action if no window matching the query exists. -}
+
+--- Basic cyclic navigation based on queries -------------------------
+
+-- | The direction in which to look for the next match
+data Direction = Forward  -- ^ Forward from current window or workspace
+               | Backward -- ^ Backward from current window or workspace
+               | History  -- ^ Backward in history
+
+-- | Focuses the next window for which the given query produces the
+-- same result as the currently focused window.  Does nothing if there
+-- is no focused window (i.e., the current workspace is empty).
+nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
+nextMatchWithThis dir qry = withFocused $ \win -> do
+  prop <- runQuery qry win
+  nextMatch dir (qry =? prop)
+
+-- | Focuses the next window that matches the given boolean query.
+-- Does nothing if there is no such window.  This is the same as
+-- 'nextMatchOrDo' with alternate action @return ()@.
+nextMatch :: Direction -> Query Bool -> X ()
+nextMatch dir qry = nextMatchOrDo dir qry (return ())
+
+-- | Focuses the next window that matches the given boolean query.  If
+-- there is no such window, perform the given action instead.
+nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
+nextMatchOrDo dir qry act = orderedWindowList dir 
+                            >>= focusNextMatchOrDo qry act
+
+-- Produces the action to perform depending on whether there's a
+-- matching window
+focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
+focusNextMatchOrDo qry act = findM (runQuery qry) 
+                             >=> maybe act (windows . SS.focusWindow)
+
+-- Returns the list of windows ordered by workspace as specified in
+-- ~/.xmonad/xmonad.hs
+orderedWindowList :: Direction -> X (Seq Window)
+orderedWindowList History = liftM (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
+orderedWindowList dir     = withWindowSet $ \ss -> do
+  wsids <- asks (Seq.fromList . workspaces . config)
+  let wspcs = orderedWorkspaceList ss wsids
+      wins  = dirfun dir 
+              $ Fold.foldl' (><) Seq.empty
+              $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
+      cur   = SS.peek ss
+  return $ maybe wins (rotfun wins) cur
+  where
+    dirfun Backward = Seq.reverse
+    dirfun _        = id
+    rotfun wins x   = rotate $ rotateTo (== x) wins
+
+-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
+orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
+orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
+    where
+      wspcs      = SS.workspaces ss
+      wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
+      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
+      isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
+
+--- History navigation, requires a layout modifier -------------------
+
+-- The state extension that holds the history information
+data HistoryDB = HistoryDB (Maybe Window) -- currently focused window 
+                           (Seq Window)   -- previously focused windows
+               deriving (Read, Show, Typeable)
+
+instance ExtensionClass HistoryDB where
+
+    initialValue  = HistoryDB Nothing Seq.empty
+    extensionType = PersistentExtension
+
+-- | Action that needs to be executed as a logHook to maintain the
+-- focus history of all windows as the WindowSet changes.
+historyHook :: X ()
+historyHook = XS.get >>= updateHistory >>= XS.put
+
+-- Updates the history in response to a WindowSet change
+updateHistory :: HistoryDB -> X HistoryDB
+updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
+  let newcur   = SS.peek ss
+      wins     = Set.fromList $ SS.allWindows ss
+      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
+  return $ HistoryDB newcur (del newcur newhist)
+  where
+    ins x xs = maybe xs (<| xs) x
+    del x xs = maybe xs (\x' -> flt (/= x') xs) x
+
+--- Two replacements for Seq.filter and Seq.breakl available only in
+--- containers-0.3.0.0, which only ships with ghc 6.12.  Once we
+--- decide to no longer support ghc < 6.12, these should be replaced
+--- with Seq.filter and Seq.breakl.
+
+flt :: (a -> Bool) -> Seq a -> Seq a
+flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
+
+brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+brkl p xs = flip Seq.splitAt xs 
+            $ snd 
+            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
+  where
+    l = Seq.length xs
+    
+--- Some sequence helpers --------------------------------------------
+
+-- Rotates the sequence by one position
+rotate :: Seq a -> Seq a
+rotate xs = rotate' (viewl xs)
+  where
+    rotate' EmptyL      = Seq.empty
+    rotate' (x' :< xs') = xs' |> x'
+
+-- Rotates the sequence until an element matching the given condition
+-- is at the beginning of the sequence.
+rotateTo :: (a -> Bool) -> Seq a -> Seq a
+rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
+
+--- A monadic find ---------------------------------------------------
+
+-- Applies the given action to every sequence element in turn until
+-- the first element is found for which the action returns true.  The
+-- remaining elements in the sequence are ignored.
+findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
+findM cond xs = findM' cond (viewl xs)
+  where
+    findM' _   EmptyL      = return Nothing
+    findM' qry (x' :< xs') = do
+      isMatch <- qry x'
+      if isMatch
+        then return (Just x')
+        else findM qry xs'

XMonad/Actions/KeyRemap.hs

@@ -0,0 +1,156 @@
+ {-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.KeyRemap
+-- Copyright   :  (c) Christian Dietrich
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  stettberger@dokucde.de
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift 
+-- is left us Layout
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.KeyRemap (
+  -- * Usage
+  -- $usage
+  setKeyRemap,
+  buildKeyRemapBindings,
+  setDefaultKeyRemap,
+
+  KeymapTable (KeymapTable),
+  emptyKeyRemap,
+  dvorakProgrammerKeyRemap
+  ) where
+
+import XMonad
+import XMonad.Util.Paste
+import Data.List
+
+import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad
+
+
+data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
+
+instance ExtensionClass KeymapTable where
+   initialValue = KeymapTable []
+
+-- $usage
+-- Provides the possibility to remap parts of the keymap to generate different keys
+--
+-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout 
+--   after all
+--
+-- First, you must add all possible keybindings for all layout you want to use:
+--
+-- >   keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]
+--
+-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the
+-- empty keyremap (no remapping is done) as default after startup):
+--
+-- > myStartupHook :: X()
+-- > myStartupHook = do
+-- >   setWMName "LG3D"
+-- >   setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]
+--
+-- Then you add keybindings for changing keyboard layouts;
+--
+-- > , ((0                    , xK_F1    ), setKeyRemap emptyKeyRemap)
+-- > , ((0                    , xK_F2    ), setKeyRemap dvorakProgrammerKeyRemap)
+--
+-- When defining your own keymappings, please be aware of:
+--
+-- * If you want to emulate a key that is shifted on us you must emulate that keypress:
+--
+-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'
+-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'
+--
+-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate
+--   the KeymapTable
+--
+-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap
+--   are nessesary
+
+doKeyRemap :: KeyMask -> KeySym -> X()
+doKeyRemap mask sym = do
+  table <- XS.get
+  let (insertMask, insertSym) = extractKeyMapping table mask sym
+  sendKey insertMask insertSym
+
+-- | Using this in the keybindings to set the actual Key Translation table
+setKeyRemap :: KeymapTable -> X()
+setKeyRemap table = do
+  let KeymapTable newtable = table
+  KeymapTable oldtable <- XS.get
+  XConf { display = dpy, theRoot = rootw } <- ask
+
+  let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+  let ungrab kc m = io $ ungrabKey dpy kc m rootw
+
+  forM_ oldtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ ungrab kc mask
+
+  forM_ newtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ grab kc mask
+
+  XS.put table
+
+-- | Adding this to your startupHook, to select your default Key Translation table.
+--   You also must give it all the KeymapTables you are willing to use
+setDefaultKeyRemap  :: KeymapTable -> [KeymapTable] -> X()
+setDefaultKeyRemap dflt keyremaps = do
+  XS.put (KeymapTable mappings)
+  setKeyRemap dflt
+  where
+    mappings = nub (keyremaps >>= \(KeymapTable table) -> table)
+
+extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)
+extractKeyMapping (KeymapTable table) mask sym =
+  insertKey filtered
+  where filtered = filter (\((m, s),_) -> m == mask && s == sym) table
+        insertKey [] = (mask, sym)
+        insertKey ((_, to):_) = to
+
+-- | Append the output of this function to your keybindings with ++
+buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
+buildKeyRemapBindings keyremaps =
+  [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
+  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
+        bindings = nub (map (\binding -> fst binding) mappings)
+
+
+-- Here come the Keymappings
+-- | The empty KeymapTable, does no translation
+emptyKeyRemap :: KeymapTable
+emptyKeyRemap = KeymapTable []
+
+-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers
+dvorakProgrammerKeyRemap :: KeymapTable
+dvorakProgrammerKeyRemap =
+  KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
+               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
+  where
+
+    layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]
+    layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./"  :: [KeySym]
+    layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
+
+    layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]
+
+    layoutDvorakShift = map getShift layoutDvorak
+    layoutDvorakKey   = map getKey layoutDvorak
+    getKey  char = let Just index = elemIndex char layoutUs
+                    in layoutUsKey !! index
+    getShift char = let Just index = elemIndex char layoutUs
+                    in layoutUsShift !! index
+    charToMask char = if [char] == "0" then 0 else shiftMask

XMonad/Actions/MessageFeedback.hs

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

XMonad/Actions/MouseResize.hs

@@ -23,12 +23,8 @@ module XMonad.Actions.MouseResize
     , MouseResize (..)
     ) where
 
-import Control.Monad
-import Data.Maybe
-
 import XMonad
 import XMonad.Layout.Decoration
-import XMonad.Layout.LayoutModifier
 
 import XMonad.Layout.WindowArranger
 import XMonad.Util.XUtils
@@ -114,6 +110,11 @@ createInputWindow ((w,r),mr) = do
     Just tr  -> withDisplay $ \d -> do
                   tw <- mkInputWindow d tr
                   io $ selectInput d tw (exposureMask .|. buttonPressMask)
+
+                  cursor <- io $ createFontCursor d xC_bottom_right_corner
+                  io $ defineCursor d tw cursor
+                  io $ freeCursor d cursor
+
                   showWindow tw
                   return ((w,r), Just tw)
     Nothing ->    return ((w,r), Nothing)

XMonad/Actions/OnScreen.hs

@@ -26,7 +26,6 @@ module XMonad.Actions.OnScreen (
     ) where
 
 import XMonad
-import XMonad.Core
 import XMonad.StackSet hiding (new)
 
 import Control.Monad (guard)
@@ -181,7 +180,7 @@ toggleOrView' f i st = fromMaybe (f i st) $ do
 --
 -- A more basic version inside the default keybindings would be:
 --
--- >        , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))
+-- >        , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1"))
 --
 -- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
 --

XMonad/Actions/PhysicalScreens.hs

@@ -19,15 +19,14 @@ module XMonad.Actions.PhysicalScreens (
                                       , getScreen
                                       , viewScreen
                                       , sendToScreen
+                                      , onNextNeighbour
+                                      , onPrevNeighbour
                                       ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import qualified Graphics.X11.Xlib as X
-import Graphics.X11.Xinerama
-
-import Data.List (sortBy)
+import Data.List (sortBy,findIndex)
 import Data.Function (on)
 
 {- $usage
@@ -44,6 +43,11 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 
 > import XMonad.Actions.PhysicalSCreens
 
+> , ((modMask, xK_a), onPrevNeighbour W.view)
+> , ((modMask, xK_o), onNextNeighbour W.view)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
+
 > --
 > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
 > -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3
@@ -61,12 +65,12 @@ newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real
 
 -- | Translate a physical screen index to a "ScreenId"
 getScreen :: PhysicalScreen -> X (Maybe ScreenId)
-getScreen (P i) = withDisplay $ \dpy -> do
-                    screens <- io $ getScreenInfo dpy
-                    if i >= length screens
-                     then return Nothing
-                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]
-                          in return $ Just $ snd $ ss !! i
+getScreen (P i) = do w <- gets windowset
+                     let screens = W.current w : W.visible w
+                     if i<0 || i >= length screens
+                      then return Nothing
+                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
+                           in return $ Just $ W.screen $ ss !! i
 
 -- | Switch to a given physical screen
 viewScreen :: PhysicalScreen -> X ()
@@ -85,4 +89,27 @@ sendToScreen p = do i <- getScreen p
 -- | Compare two screens by their top-left corners, ordering
 -- | top-to-bottom and then left-to-right.
 cmpScreen :: Rectangle -> Rectangle -> Ordering
-cmpScreen  (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+
+
+-- | Get ScreenId for neighbours of the current screen based on position offset.
+getNeighbour :: Int -> X ScreenId
+getNeighbour d = do w <- gets windowset
+                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
+                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
+                        pos = (curPos + d) `mod` length ss
+                    return $ ss !! pos
+
+neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows d f = do s <- getNeighbour d
+                          w <- screenWorkspace s
+                          whenJust w $ windows . f
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
+onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onNextNeighbour = neighbourWindows 1
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
+onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onPrevNeighbour = neighbourWindows (-1)
+

XMonad/Actions/Search.hs

@@ -44,26 +44,32 @@ module XMonad.Actions.Search (   -- * Usage
                                  lucky,
                                  maps,
                                  mathworld,
+                                 openstreetmap,
                                  scholar,
                                  thesaurus,
                                  wayback,
                                  wikipedia,
                                  wiktionary,
                                  youtube,
-                                 multi
+                                 multi,
                                   -- * Use case: searching with a submap
                                   -- $tip
+
+                                  -- * Types
+                                 Browser, Site, Query, Name, Search
                           ) where
 
-import Data.Char (chr, ord, isAlpha, isMark, isDigit)
+import Codec.Binary.UTF8.String (encode)
+import Data.Char (isAlphaNum, isAscii)
 import Data.List (isPrefixOf)
-import Numeric (showIntAtBase)
+import Text.Printf
 import XMonad (X(), MonadIO, liftIO)
-import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP)
+import XMonad.Prompt (XPrompt(showXPrompt, nextCompletion, commandToComplete), mkXPrompt, XPConfig(), historyCompletionP, getNextCompletion)
 import XMonad.Prompt.Shell (getBrowser)
 import XMonad.Util.Run (safeSpawn)
 import XMonad.Util.XSelection (getSelection)
 
+
 {- $usage
 
    This module is intended to allow easy access to databases on the
@@ -120,6 +126,8 @@ import XMonad.Util.XSelection (getSelection)
 
 * 'mathworld' -- Wolfram MathWorld search.
 
+* 'openstreetmap' -- OpenStreetMap free wiki world map.
+
 * 'scholar' -- Google scholar academic search.
 
 * 'thesaurus' -- thesaurus.reference.com search.
@@ -194,31 +202,18 @@ Happy searching! -}
 data Search = Search Name
 instance XPrompt Search where
     showXPrompt (Search name)= "Search [" ++ name ++ "]: "
+    nextCompletion _ = getNextCompletion
+    commandToComplete _ c = c
 
--- | Escape the search string so search engines understand it.
--- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
--- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.
+-- | Escape the search string so search engines understand it. Only
+-- digits and ASCII letters are not encoded. All non ASCII characters
+-- which are encoded as UTF8
 escape :: String -> String
-escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
-         where -- Copied from Network.URI.
-           escapeURIString ::
-               (Char -> Bool)      -- a predicate which returns 'False' if should escape
-               -> String           -- the string to process
-               -> String           -- the resulting URI string
-           escapeURIString = concatMap . escapeURIChar
-           escapeURIChar :: (Char->Bool) -> Char -> String
-           escapeURIChar p c
-               | p c       = [c]
-               | otherwise = '%' : myShowHex (ord c) ""
-               where
-                 myShowHex :: Int -> ShowS
-                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of
-                                    []  -> "00"
-                                    [ch] -> ['0',ch]
-                                    cs  -> cs
-                 toChrHex d
-                   | d < 10    = chr (ord '0' + fromIntegral d)
-                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+escape = concatMap escapeURIChar
+
+escapeURIChar :: Char -> String
+escapeURIChar c | isAscii c && isAlphaNum c = [c]
+                | otherwise                 = concatMap (printf "%%%02X") $ encode [c]
 
 type Browser      = FilePath
 type Query        = String
@@ -258,8 +253,8 @@ searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
 
 > searchFunc :: String -> String
-> searchFunc s | s `isPrefixOf` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
->              | s `isPrefixOf` "http://" = s
+> searchFunc s | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
+>              | "http://" `isPrefixOf` s = s
 >              | otherwise               = (use google) s
 > myNewEngine = searchEngineF "mymulti" searchFunc
 
@@ -276,33 +271,34 @@ searchEngineF = SearchEngine
 
 -- The engines.
 amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
-  images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary,
+  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary,
   youtube :: SearchEngine
-amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
-alpha      = searchEngine "alpha"      "http://www.wolframalpha.com/input/?i="
-codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
-deb        = searchEngine "deb"        "http://packages.debian.org/"
-debbts     = searchEngine "debbts"     "http://bugs.debian.org/"
-debpts     = searchEngine "debpts"     "http://packages.qa.debian.org/"
-dictionary = searchEngine "dict"       "http://dictionary.reference.com/browse/"
-google     = searchEngine "google"     "http://www.google.com/search?num=100&q="
-hackage    = searchEngine "hackage"    "http://hackage.haskell.org/package/"
-hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="
-images     = searchEngine "images"     "http://images.google.fr/images?q="
-imdb       = searchEngine "imdb"       "http://www.imdb.com/find?s=all&q="
-isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="
-lucky      = searchEngine "lucky"      "http://www.google.com/search?btnI&q="
-maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
-mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
-scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
-thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
-wikipedia  = searchEngine "wiki"       "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
-wiktionary = searchEngine "wikt"       "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
-youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
-wayback    = searchEngineF "wayback"   ("http://web.archive.org/web/*/"++)
+amazon        = searchEngine "amazon"        "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
+alpha         = searchEngine "alpha"         "http://www.wolframalpha.com/input/?i="
+codesearch    = searchEngine "codesearch"    "http://www.google.com/codesearch?q="
+deb           = searchEngine "deb"           "http://packages.debian.org/"
+debbts        = searchEngine "debbts"        "http://bugs.debian.org/"
+debpts        = searchEngine "debpts"        "http://packages.qa.debian.org/"
+dictionary    = searchEngine "dict"          "http://dictionary.reference.com/browse/"
+google        = searchEngine "google"        "http://www.google.com/search?num=100&q="
+hackage       = searchEngine "hackage"       "http://hackage.haskell.org/package/"
+hoogle        = searchEngine "hoogle"        "http://www.haskell.org/hoogle/?q="
+images        = searchEngine "images"        "http://images.google.fr/images?q="
+imdb          = searchEngine "imdb"          "http://www.imdb.com/find?s=all&q="
+isohunt       = searchEngine "isohunt"       "http://isohunt.com/torrents/?ihq="
+lucky         = searchEngine "lucky"         "http://www.google.com/search?btnI&q="
+maps          = searchEngine "maps"          "http://maps.google.com/maps?q="
+mathworld     = searchEngine "mathworld"     "http://mathworld.wolfram.com/search/?query="
+openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
+scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="
+thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="
+wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
+wiktionary    = searchEngine "wikt"          "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
+youtube       = searchEngine "youtube"       "http://www.youtube.com/results?search_type=search_videos&search_query="
+wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)
 
 multi :: SearchEngine
-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
 
 {- | This function wraps up a search engine and creates a new one, which works
    like the argument, but goes directly to a URL if one is given rather than
@@ -331,14 +327,14 @@ removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
   \"mathworld:integral\" will search mathworld, and everything else will fall back to
   google. The use of intelligent will make sure that URLs are opened directly. -}
 (!>) :: SearchEngine -> SearchEngine -> SearchEngine
-(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s)
+(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)
 
 {- | Makes a search engine prefix-aware. Especially useful together with '!>'.
    It will automatically remove the prefix from a query so that you don\'t end
      up searching for google:xmonad if google is your fallback engine and you
      explicitly add the prefix. -}
 prefixAware :: SearchEngine -> SearchEngine
-prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s)
+prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s)
 
 {- | Changes search engine's name -}
 namedEngine :: Name -> SearchEngine -> SearchEngine

XMonad/Actions/Submap.hs

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

XMonad/Actions/SwapWorkspaces.hs

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

XMonad/Actions/TagWindows.hs

@@ -22,17 +22,23 @@ module XMonad.Actions.TagWindows (
                  focusDownTagged, focusDownTaggedGlobal,
                  shiftHere, shiftToScreen,
                  tagPrompt,
-                 tagDelPrompt
+                 tagDelPrompt,
+                 TagPrompt,
                  ) where
 
-import Data.List (nub,concat,sortBy)
+import Prelude hiding (catch)
+import Data.List (nub,sortBy)
 import Control.Monad
+import Control.Exception
 
 import XMonad.StackSet hiding (filter)
 
 import XMonad.Prompt
 import XMonad hiding (workspaces)
 
+econst :: Monad m => a -> IOException -> m a
+econst = const . return
+
 -- $usage
 --
 -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
@@ -79,7 +85,7 @@ getTags w = withDisplay $ \d ->
     io $ catch (internAtom d "_XMONAD_TAGS" False >>=
                 getTextProperty d w >>=
                 wcTextPropertyToTextList d)
-               (\_ -> return [[]])
+               (econst [[]])
     >>= return . words . unwords
 
 -- | check a window for the given tag

XMonad/Actions/TopicSpace.hs

@@ -25,6 +25,7 @@ module XMonad.Actions.TopicSpace
   , defaultTopicConfig
   , getLastFocusedTopics
   , setLastFocusedTopic
+  , reverseLastFocusedTopics
   , pprWindowSet
   , topicActionWithPrompt
   , topicAction
@@ -41,13 +42,12 @@ where
 import XMonad
 
 import Data.List
-import Data.Maybe (fromMaybe, isNothing, listToMaybe)
+import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
 import Data.Ord
 import qualified Data.Map as M
-import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
+import Control.Monad (liftM2,when,unless,replicateM_)
 import System.IO
 
-import XMonad.Operations
 import qualified XMonad.StackSet as W
 
 import XMonad.Prompt
@@ -226,11 +226,17 @@ getLastFocusedTopics = XS.gets getPrevTopics
 -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
 -- select topics that one want to keep, this function will set the property
 -- of last focused topics.
-setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
-setLastFocusedTopic tg w predicate =
+setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
+setLastFocusedTopic w predicate =
   XS.modify $ PrevTopics
-    . take (maxTopicHistory tg) . nub . (w:) . filter predicate
+    . seqList . nub . (w:) . filter predicate
     . getPrevTopics
+  where seqList xs = length xs `seq` xs
+
+-- | Reverse the list of "last focused topics"
+reverseLastFocusedTopics :: X ()
+reverseLastFocusedTopics =
+  XS.modify $ PrevTopics . reverse . getPrevTopics
 
 -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
 -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
@@ -241,13 +247,13 @@ pprWindowSet tg pp = do
     urgents <- readUrgents
     let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
         maxDepth = maxTopicHistory tg
-    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)
-                           (`notElem` empty_workspaces)
+    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
+                        (`notElem` empty_workspaces)
     lastWs <- getLastFocusedTopics
-    let depth topic = elemIndex topic lastWs
-        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic
+    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
+        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
         pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
-        sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)
+        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
     return $ DL.pprWindowSet sortWindows urgents pp' winset
 
 -- | Given a prompt configuration and a topic configuration, triggers the action associated with
@@ -271,7 +277,7 @@ switchTopic tg topic = do
   when (null wins) $ topicAction tg topic
 
 -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
-switchNthLastFocused ::TopicConfig -> Int -> X ()
+switchNthLastFocused :: TopicConfig -> Int -> X ()
 switchNthLastFocused tg depth = do
   lastWs <- getLastFocusedTopics
   switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth

XMonad/Actions/UpdateFocus.hs

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

XMonad/Actions/UpdatePointer.hs

@@ -24,6 +24,7 @@ module XMonad.Actions.UpdatePointer
     where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Control.Monad
 import XMonad.StackSet (member, peek, screenDetail, current)
 import Data.Maybe
@@ -102,6 +103,3 @@ moveWithin now lower upper =
     else if now > upper
          then upper
          else now
-
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral

XMonad/Actions/Warp.hs

@@ -22,7 +22,6 @@ module XMonad.Actions.Warp (
                            warpToWindow
                           ) where
 
-import Data.Ratio
 import Data.List
 import XMonad
 import XMonad.StackSet as W

XMonad/Actions/WindowBringer.hs

@@ -17,7 +17,9 @@
 module XMonad.Actions.WindowBringer (
                     -- * Usage
                     -- $usage
-                    gotoMenu, gotoMenu', bringMenu, windowMap,
+                    gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',
+                    bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',
+                    windowMap,
                     bringWindow
                    ) where
 
@@ -27,7 +29,7 @@ import qualified Data.Map as M
 import qualified XMonad.StackSet as W
 import XMonad
 import qualified XMonad as X
-import XMonad.Util.Dmenu (menuMap)
+import XMonad.Util.Dmenu (menuMapArgs)
 import XMonad.Util.NamedWindows (getName)
 
 -- $usage
@@ -44,19 +46,54 @@ import XMonad.Util.NamedWindows (getName)
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+-- | Default menu command
+defaultCmd :: String
+defaultCmd = "dmenu"
 
 -- | Pops open a dmenu with window titles. Choose one, and you will be
 --   taken to the corresponding workspace.
 gotoMenu :: X ()
-gotoMenu = actionMenu W.focusWindow
+gotoMenu = gotoMenuArgs []
 
+-- | Pops open a dmenu with window titles. Choose one, and you will be
+--   taken to the corresponding workspace. This version takes a list of
+--   arguments to pass to dmenu.
+gotoMenuArgs :: [String] -> X ()
+gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace.
 gotoMenu' :: String -> X ()
-gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow
+gotoMenu' menuCmd = gotoMenuArgs' menuCmd []
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace. This version takes a
+--   list of arguments to pass to dmenu.
+gotoMenuArgs' :: String -> [String] -> X ()
+gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs W.focusWindow
 
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
-bringMenu = actionMenu bringWindow
+bringMenu = bringMenuArgs []
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   dragged, kicking and screaming, into your current workspace. This version
+--   takes a list of arguments to pass to dmenu.
+bringMenuArgs :: [String] -> X ()
+bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace.
+bringMenu' :: String -> X ()
+bringMenu' menuCmd = bringMenuArgs' menuCmd []
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace. This version allows arguments to the chooser to be specified.
+bringMenuArgs' :: String -> [String] -> X ()
+bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow
 
 -- | Brings the specified window into the current workspace.
 bringWindow :: Window -> X.WindowSet -> X.WindowSet
@@ -64,14 +101,11 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
 
 -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
 --   if found.
-actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu action = actionMenu' "dmenu" action
-
-actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
+actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
+actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
     where
       menuMapFunction :: M.Map String a -> X (Maybe a)
-      menuMapFunction selectionMap = menuMap menuCmd selectionMap
+      menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap
 
 -- | A map from window names to Windows.
 windowMap :: X (M.Map String Window)

XMonad/Actions/WindowGo.hs

@@ -80,8 +80,11 @@ ifWindows qry f el = withWindowSet $ \wins -> do
 ifWindow :: Query Bool -> ManageHook -> X () -> X ()
 ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
 
--- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
---   Presumably this executable is the same one that you were looking for.
+{- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
+   Presumably this executable is the same one that you were looking for.
+   Note that this does not go through the shell. If you wish to run an arbitrary IO action
+   (such as 'spawn', which will run its String argument through the shell), then you will want to use
+   'raiseMaybe' directly. -}
 runOrRaise :: String -> Query Bool -> X ()
 runOrRaise = raiseMaybe . safeSpawnProg
 
@@ -160,11 +163,11 @@ raiseEditor  = raiseVar getEditor
 {- | If the window is found the window is focused and the third argument is called
      otherwise, the first argument is called
      See 'raiseMaster' for an example. -}
-raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()
+raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X ()
 raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f
     where afterRaise = ask >>= (>> idHook) . liftX . after
 
-{- | If a window matching the second arugment is found, the window is focused and the third argument is called;
+{- | If a window matching the second argument is found, the window is focused and the third argument is called;
      otherwise, the first argument is called. -}
 runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()
 runOrRaiseAndDo = raiseAndDo . safeSpawnProg

XMonad/Actions/WindowMenu.hs

@@ -41,6 +41,14 @@ import XMonad.Util.XUtils (fi)
 --
 -- >    , ((modm,               xK_o ), windowMenu)
 
+colorizer :: a -> Bool -> X (String, String)
+colorizer _ isFg = do
+    fBC <- asks (focusedBorderColor . config)
+    nBC <- asks (normalBorderColor . config)
+    return $ if isFg
+                then (fBC, nBC)
+                else (nBC, fBC)
+
 windowMenu :: X ()
 windowMenu = withFocused $ \w -> do
     tags <- asks (workspaces . config)
@@ -48,13 +56,13 @@ windowMenu = withFocused $ \w -> do
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
-        gsConfig = defaultGSConfig
+        gsConfig = (buildDefaultGSConfig colorizer)
                     { gs_originFractX = originFractX
                     , gs_originFractY = originFractY }
         actions = [ ("Cancel menu", return ())
                   , ("Close"      , kill)
                   , ("Maximize"   , sendMessage $ maximizeRestore w)
-                  , ("Minimize"   , sendMessage $ MinimizeWin w)
+                  , ("Minimize"   , minimizeWindow w)
                   ] ++
                   [ ("Move to " ++ tag, windows $ W.shift tag)
                     | tag <- tags ]

XMonad/Actions/WindowNavigation.hs

@@ -36,7 +36,7 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
-                                       Direction2D(..)
+                                       Direction2D(..), WNState,
                                        ) where
 
 import XMonad
@@ -52,7 +52,6 @@ import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Data.Ord (comparing)
 import qualified Data.Set as S
-import Graphics.X11.Xlib
 
 -- $usage
 --

XMonad/Actions/WithAll.hs

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

XMonad/Actions/WorkspaceCursors.hs

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

XMonad/Actions/WorkspaceNames.hs

@@ -0,0 +1,152 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WorkspaceNames
+-- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Tomas Janousek <tomi@nomi.cz>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Provides bindings to rename workspaces, show these names in DynamicLog and
+-- swap workspaces along with their names. These names survive restart.
+-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
+-- dynamic topic space workflow.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.WorkspaceNames (
+    -- * Usage
+    -- $usage
+
+    -- * Workspace naming
+    renameWorkspace,
+    workspaceNamesPP,
+    getWorkspaceNames,
+    setWorkspaceName,
+    setCurrentWorkspaceName,
+
+    -- * Workspace swapping
+    swapTo,
+    swapTo',
+    swapWithCurrent,
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
+import qualified XMonad.Actions.SwapWorkspaces as Swap
+import XMonad.Hooks.DynamicLog (PP(..))
+import XMonad.Prompt (mkXPrompt, XPConfig)
+import XMonad.Prompt.Workspace (Wor(Wor))
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.WorkspaceNames
+--
+-- Then add keybindings like the following:
+--
+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
+--
+-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
+--
+-- > myLogHook =
+-- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
+--
+-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
+-- functionality, which may be used this way:
+--
+-- >   , ((modMask .|. shiftMask, xK_Left  ), swapTo Prev)
+-- >   , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
+--
+-- > [((modm .|. controlMask, k), swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+
+-- | Workspace names container.
+newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
+    deriving (Typeable, Read, Show)
+
+instance ExtensionClass WorkspaceNames where
+    initialValue = WorkspaceNames M.empty
+    extensionType = PersistentExtension
+
+-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
+-- workspaces with a name, and to @\"t\"@ otherwise.
+getWorkspaceNames :: X (WorkspaceId -> String)
+getWorkspaceNames = do
+    WorkspaceNames m <- XS.get
+    return $ \wks -> case M.lookup wks m of
+        Nothing -> wks
+        Just s  -> wks ++ ":" ++ s
+
+-- | Sets the name of a workspace. Empty string makes the workspace unnamed
+-- again.
+setWorkspaceName :: WorkspaceId -> String -> X ()
+setWorkspaceName w name = do
+    WorkspaceNames m <- XS.get
+    XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m
+    refresh
+
+-- | Sets the name of the current workspace. See 'setWorkspaceName'.
+setCurrentWorkspaceName :: String -> X ()
+setCurrentWorkspaceName name = do
+    current <- gets (W.currentTag . windowset)
+    setWorkspaceName current name
+
+-- | Prompt for a new name for the current workspace and set it.
+renameWorkspace :: XPConfig -> X ()
+renameWorkspace conf = do
+    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
+    where pr = Wor "Workspace name: "
+
+-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
+-- workspace names as well.
+workspaceNamesPP :: PP -> X PP
+workspaceNamesPP pp = do
+    names <- getWorkspaceNames
+    return $
+        pp {
+            ppCurrent         = ppCurrent         pp . names,
+            ppVisible         = ppVisible         pp . names,
+            ppHidden          = ppHidden          pp . names,
+            ppHiddenNoWindows = ppHiddenNoWindows pp . names,
+            ppUrgent          = ppUrgent          pp . names
+        }
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
+swapTo :: Direction1D -> X ()
+swapTo dir = swapTo' dir AnyWS
+
+-- | Swap with the previous or next workspace of the given type.
+swapTo' :: Direction1D -> WSType -> X ()
+swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
+-- same with names.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent t = do
+    current <- gets (W.currentTag . windowset)
+    swapNames t current
+    windows $ Swap.swapWorkspaces t current
+
+-- | Swap names of the two workspaces.
+swapNames :: WorkspaceId -> WorkspaceId -> X ()
+swapNames w1 w2 = do
+    WorkspaceNames m <- XS.get
+    let getname w = fromMaybe "" $ M.lookup w m
+        set w name m' = if null name then M.delete w m' else M.insert w name m'
+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m

XMonad/Config/Azerty.hs

@@ -38,7 +38,7 @@ import qualified Data.Map as M
 -- > import qualified Data.Map as M
 -- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
 
-azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }
+azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig }
 
 azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]

XMonad/Config/Bluetile.hs

@@ -26,7 +26,6 @@ module XMonad.Config.Bluetile (
 
 import XMonad hiding ( (|||) )
 
-import XMonad.Layout hiding ( (|||) )
 import XMonad.Layout.BorderResize
 import XMonad.Layout.BoringWindows
 import XMonad.Layout.ButtonDecoration
@@ -49,8 +48,9 @@ import XMonad.Actions.WindowMenu
 import XMonad.Hooks.CurrentWorkspaceOnTop
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
 import XMonad.Hooks.PositionStoreHooks
-import XMonad.Hooks.RestoreMinimized
+import XMonad.Hooks.Minimize
 import XMonad.Hooks.ServerMode
 import XMonad.Hooks.WorkspaceByPos
 
@@ -118,8 +118,8 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
     , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- quit, or restart
-    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit bluetile
-    , ((modMask'              , xK_q     ), spawn "bluetile --restart") -- %! Restart bluetile
+    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit
+    , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart
 
     -- Metacity-like workspace switching
     , ((mod1Mask .|. controlMask, xK_Left), prevWS)
@@ -141,7 +141,7 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
     , ((modMask'              , xK_z), withFocused (sendMessage . maximizeRestore))
 
     -- Minimizing
-    , ((modMask',               xK_m     ), withFocused (\f -> sendMessage (MinimizeWin f)))
+    , ((modMask',               xK_m     ), withFocused minimizeWindow)
     , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
     ]
     ++
@@ -177,11 +177,12 @@ isFloating w = do
 
 bluetileManageHook :: ManageHook
 bluetileManageHook = composeAll
-               [ workspaceByPos, positionStoreManageHook
+               [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)
                 , className =? "MPlayer" --> doFloat
+                , isFullscreen --> doFullFloat
                 , manageDocks]
 
-bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ (
+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
                         named "Floating" floating |||
                         named "Tiled1" tiled1 |||
                         named "Tiled2" tiled2 |||
@@ -203,13 +204,14 @@ bluetileConfig =
           layoutHook = bluetileLayoutHook,
           logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,
           handleEventHook = ewmhDesktopsEventHook
-                                `mappend` restoreMinimizedEventHook
+                                `mappend` fullscreenEventHook
+                                `mappend` minimizeEventHook
                                 `mappend` serverModeEventHook' bluetileCommands
                                 `mappend` positionStoreEventHook,
           workspaces = bluetileWorkspaces,
           keys = bluetileKeys,
           mouseBindings = bluetileMouseBindings,
-          focusFollowsMouse  = False,
-          focusedBorderColor = "#ff5500",
+          focusFollowsMouse = False,
+          focusedBorderColor = "#000000",
           terminal = "gnome-terminal"
         }

XMonad/Config/Desktop.hs

@@ -54,7 +54,6 @@ module XMonad.Config.Desktop (
     ) where
 
 import XMonad
-import XMonad.Config (defaultConfig)
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Util.Cursor
@@ -127,7 +126,7 @@ import qualified Data.Map as M
 -- To add to the logHook while still sending workspace and window information
 -- to DE apps use something like:
 --
--- >  , logHook = myLogHook >> logHook desktopConfig
+-- >  , logHook = myLogHook <+> logHook desktopConfig
 --
 -- Or for more elaborate logHooks you can use @do@:
 --
@@ -139,25 +138,23 @@ import qualified Data.Map as M
 
 -- $eventHook
 -- To customize xmonad's event handling while still having it respond
--- to EWMH events from pagers, task bars, etc. add to your imports:
+-- to EWMH events from pagers, task bars:
 --
--- > import Data.Monoid
+-- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig
 --
--- and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@)
---
--- >  , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig)
---
--- or 'Data.Monoid.mconcat' (like @composeAll@)
+-- or 'mconcat' if you write a list event of event hooks
 --
 -- >  , handleEventHook = mconcat
 -- >        [ myMouseHandler
 -- >        , myMessageHandler
 -- >        , handleEventHook desktopConfig ]
 --
+-- Note that the event hooks are run left to right (in contrast to
+-- 'ManageHook'S which are right to left)
 
 -- $startupHook
 -- To run the desktop startupHook, plus add further actions to be run each
--- time xmonad starts or restarts, use '>>' to combine actions as in the
+-- time xmonad starts or restarts, use '<+>' to combine actions as in the
 -- logHook example, or something like:
 --
 -- >  , startupHook = do
@@ -170,7 +167,7 @@ desktopConfig = ewmh defaultConfig
     { startupHook     = setDefaultCursor xC_left_ptr
     , layoutHook      = desktopLayoutModifiers $ layoutHook defaultConfig
     , manageHook      = manageHook defaultConfig <+> manageDocks
-    , keys            = \c -> desktopKeys c `M.union` keys defaultConfig c }
+    , keys            = desktopKeys <+> keys defaultConfig }
 
 desktopKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_b), sendMessage ToggleStruts) ]

XMonad/Config/Droundy.hs

@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Copyright   :  (c) Spencer Janssen 2007
@@ -10,7 +11,6 @@ module XMonad.Config.Droundy ( config, mytab ) where
 
 import XMonad hiding (keys, config, (|||))
 import qualified XMonad (keys)
-import XMonad.Config ( defaultConfig )
 
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M

XMonad/Config/Gnome.hs

@@ -41,7 +41,7 @@ import System.Environment (getEnvironment)
 
 gnomeConfig = desktopConfig
     { terminal = "gnome-terminal"
-    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c
+    , keys     = gnomeKeys <+> keys desktopConfig
     , startupHook = gnomeRegister >> startupHook desktopConfig }
 
 gnomeKeys (XConfig {modMask = modm}) = M.fromList $

XMonad/Config/Kde.hs

@@ -40,11 +40,11 @@ import qualified Data.Map as M
 
 kdeConfig = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }
+    , keys     = kdeKeys <+> keys desktopConfig }
 
 kde4Config = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }
+    , keys     = kde4Keys <+> keys desktopConfig }
 
 kdeKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")

XMonad/Config/Sjanssen.hs

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

XMonad/Config/Xfce.hs

@@ -36,7 +36,7 @@ import qualified Data.Map as M
 
 xfceConfig = desktopConfig
     { terminal = "Terminal"
-    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }
+    , keys     = xfceKeys <+> keys desktopConfig }
 
 xfceKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "xfrun4")

XMonad/Doc/Developing.hs

@@ -256,6 +256,9 @@ xmonad contributed extensions.
 * Code should be compilable with "ghc-options: -Wall -Werror" set in the
 xmonad-contrib.cabal file. There should be no warnings.
 
+* Code should be free of any warnings or errors from the Hlint tool; use your
+  best judgement on some warnings like eta-reduction or bracket removal, though.
+
 * Partial functions should be avoided: the window manager should not
   crash, so never call 'error' or 'undefined'.
 

XMonad/Doc/Extending.hs

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

XMonad/Hooks/CurrentWorkspaceOnTop.hs

@@ -26,6 +26,7 @@ import XMonad
 import qualified XMonad.StackSet as S
 import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad(when)
+import qualified Data.Map as M
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -50,12 +51,18 @@ currentWorkspaceOnTop = withDisplay $ \d -> do
     (CWOTS lastTag) <- XS.get
     let curTag = S.tag . S.workspace . S.current $ ws
     when (curTag /= lastTag) $ do
+        -- the following is more or less a reimplementation of what's happening in "XMonad.Operation"
         let s = S.current ws
             wsp = S.workspace s
             viewrect = screenRect $ S.screenDetail s
-            tmpStack = S.stack . S.workspace $ s
-        (rs, _) <- runLayout wsp { S.stack = tmpStack } viewrect
-        let wins = map fst rs
+            tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)
+        (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
+        updateLayout curTag ml'
+        let this = S.view curTag ws
+            fltWins = filter (flip M.member (S.floating ws)) $ S.index this
+            wins = fltWins ++ (map fst rs)  -- order: first all floating windows, then the order the layout returned
+        -- end of reimplementation
+
         when (not . null $ wins) $ do
             io $ raiseWindow d (head wins)  -- raise first window of current workspace to the very top,
             io $ restackWindows d wins      -- then use restackWindows to let all other windows from the workspace follow

XMonad/Hooks/DebugKeyEvents.hs

@@ -0,0 +1,107 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.DebugKeyEvents
+-- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Brandon S Allbery <allbery.b@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- A debugging module to track key events, useful when you can't tell whether
+-- xmonad is processing some or all key events.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugKeyEvents (-- * Usage
+                                    -- $usage
+                                    debugKeyEvents
+                                   ) where
+
+import           XMonad.Core
+import           XMonad.Operations               (cleanMask)
+
+import           Graphics.X11.Xlib
+import           Graphics.X11.Xlib.Extras
+
+import           Control.Monad.State             (gets)
+import           Data.Bits
+import           Data.List                       (intercalate)
+import           Data.Monoid
+import           Numeric                         (showHex)
+import           System.IO                       (hPutStrLn
+                                                 ,stderr)
+
+-- $usage
+-- Add this to your handleEventHook to print received key events to the
+-- log (the console if you use @startx@/@xinit@, otherwise usually
+-- @~/.xsession-errors@).
+--
+-- >      , handleEventHook = debugKeyEvents
+--
+-- If you already have a handleEventHook then you should append it:
+--
+-- >      , handleEventHook = ... <+> debugKeyEvents
+--
+-- Logged key events look like:
+--
+-- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@
+-- 
+-- The @mask@ and @clean@ indicate the modifiers pressed along with
+-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after
+-- sanitizing it (removing @numberLockMask@, etc.)
+--
+-- For more detailed instructions on editing the logHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+
+-- | Print key events to stderr for debugging
+debugKeyEvents :: Event -> X All
+debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
+  | t == keyPress =
+      withDisplay $ \dpy -> do
+        sym <- io $ keycodeToKeysym dpy code 0
+        msk <- cleanMask m
+        nl <- gets numberlockMask
+        io $ hPutStrLn stderr $ intercalate " " ["keycode"
+                                                ,show code
+                                                ,"sym"
+                                                ,show sym
+                                                ," ("
+                                                ,hex sym
+                                                ," \""
+                                                ,keysymToString sym
+                                                ,"\") mask"
+                                                ,hex m
+                                                ,"(" ++ vmask nl m ++ ")"
+                                                ,"clean"
+                                                ,hex msk
+                                                ,"(" ++ vmask nl msk ++ ")"
+                                                ]
+        return (All True)
+debugKeyEvents _ = return (All True)
+
+-- | Convenient showHex variant
+hex :: (Integral n, Show n) => n -> String
+hex v = "0x" ++ showHex v ""
+
+-- | Convert a modifier mask into a useful string
+vmask                 :: KeyMask -> KeyMask -> String
+vmask numLockMask msk =  intercalate " " $
+                         reverse $
+                         fst $
+                         foldr vmask' ([],msk) masks
+    where
+      masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] ++
+              [(numLockMask,"num"  )
+              ,(   lockMask,"lock" )
+              ,(controlMask,"ctrl" )
+              ,(  shiftMask,"shift")
+              ,(   mod5Mask,"mod5" )
+              ,(   mod4Mask,"mod4" )
+              ,(   mod3Mask,"mod3" )
+              ,(   mod2Mask,"mod2" )
+              ,(   mod1Mask,"mod1" )
+              ]
+      vmask'   _   a@( _,0)                = a
+      vmask' (m,s)   (ss,v) | v .&. m == m = (s:ss,v .&. complement m)
+      vmask'   _        r                  = r

XMonad/Hooks/DynamicLog.hs

@@ -29,6 +29,7 @@ module XMonad.Hooks.DynamicLog (
     dynamicLog,
     dynamicLogXinerama,
 
+    xmonadPropLog',
     xmonadPropLog,
 
     -- * Build your own formatter
@@ -53,27 +54,26 @@ module XMonad.Hooks.DynamicLog (
 
   ) where
 
---
 -- Useful imports
---
-import XMonad
-import Control.Monad
+
+import Codec.Binary.UTF8.String (encodeString)
+import Control.Monad (liftM2)
 import Data.Char ( isSpace, ord )
+import Data.List (intersperse, isPrefixOf, sortBy)
 import Data.Maybe ( isJust, catMaybes )
-import Data.List
-import qualified Data.Map as M
 import Data.Ord ( comparing )
+import qualified Data.Map as M
 import qualified XMonad.StackSet as S
-import System.IO
 
 import Foreign.C (CChar)
 
+import XMonad
+
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.NamedWindows
 import XMonad.Util.Run
 
 import XMonad.Layout.LayoutModifier
-import XMonad.Util.Font
 import XMonad.Hooks.UrgencyHook
 import XMonad.Hooks.ManageDocks
 
@@ -209,20 +209,24 @@ statusBar cmd pp k conf = do
  where
     keys' = (`M.singleton` sendMessage ToggleStruts) . k
 
--- | Write a string to the property _XMONAD_LOG on the root window.  This
--- property is of type UTF8_STRING. The string must have been processed by
--- encodeString (dynamicLogString does this).
-xmonadPropLog :: String -> X ()
-xmonadPropLog msg = do
+-- | Write a string to a property on the root window.  This property is of
+-- type UTF8_STRING. The string must have been processed by encodeString
+-- (dynamicLogString does this).
+xmonadPropLog' :: String -> String -> X ()
+xmonadPropLog' prop msg = do
     d <- asks display
     r <- asks theRoot
-    xlog <- getAtom "_XMONAD_LOG"
+    xlog <- getAtom prop
     ustring <- getAtom "UTF8_STRING"
     io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)
  where
     encodeCChar :: String -> [CChar]
     encodeCChar = map (fromIntegral . ord)
 
+-- | Write a string to the _XMONAD_LOG property on the root window.
+xmonadPropLog :: String -> X ()
+xmonadPropLog = xmonadPropLog' "_XMONAD_LOG"
+
 -- |
 -- Helper function which provides ToggleStruts keybinding
 --
@@ -270,9 +274,9 @@ dynamicLogString pp = do
     wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
 
     -- run extra loggers, ignoring any that generate errors.
-    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
+    extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp
 
-    return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $
+    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
                         [ ws
                         , ppLayout pp ld
                         , ppTitle  pp wt
@@ -303,10 +307,15 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
 -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,
 -- and 2 and 7 are non-visible, non-empty workspaces.
 --
--- Unfortunately, at the present time, the current layout and window title
--- are not shown, and there is no way to incorporate the xinerama
--- workspace format shown above with 'dynamicLogWithPP'.  Hopefully this
--- will change soon.
+-- At the present time, the current layout and window title
+-- are not shown.  The xinerama workspace format shown above can be (mostly) replicated
+-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from
+-- "XMonad.Util.WorkspaceCompare".  For example,
+--
+-- > defaultPP { ppCurrent = dzenColor "red" "#efebe7"
+-- >           , ppVisible = wrap "[" "]"
+-- >           , ppSort    = getSortByXineramaRule
+-- >           }
 dynamicLogXinerama :: X ()
 dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
 
@@ -337,7 +346,7 @@ trim = f . f
 -- | Limit a string to a certain length, adding "..." if truncated.
 shorten :: Int -> String -> String
 shorten n xs | length xs < n = xs
-             | otherwise     = (take (n - length end) xs) ++ end
+             | otherwise     = take (n - length end) xs ++ end
  where
     end = "..."
 
@@ -476,11 +485,11 @@ dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
                    , ppWsSep    = ""
                    , ppSep      = ""
                    , ppLayout   = dzenColor "black" "#cccccc" .
-                                  (\ x -> case x of
-                                            "TilePrime Horizontal" -> " TTT "
-                                            "TilePrime Vertical"   -> " []= "
-                                            "Hinted Full"          -> " [ ] "
-                                            _                      -> pad x
+                                  (\ x -> pad $ case x of
+                                            "TilePrime Horizontal" -> "TTT"
+                                            "TilePrime Vertical"   -> "[]="
+                                            "Hinted Full"          -> "[ ]"
+                                            _                      -> x
                                   )
                    , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
                    }
@@ -515,4 +524,3 @@ byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
   where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']
                                        then pad wsId
                                        else ""
-

XMonad/Hooks/EwmhDesktops.hs

@@ -19,7 +19,8 @@ module XMonad.Hooks.EwmhDesktops (
     ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
-    ewmhDesktopsEventHook
+    ewmhDesktopsEventHook,
+    fullscreenEventHook
     ) where
 
 import Codec.Binary.UTF8.String (encode)
@@ -34,6 +35,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.SetWMName
 import XMonad.Util.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
+import XMonad.Util.WindowProperties (getProp32)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -154,6 +156,36 @@ handle ClientMessageEvent {
           return ()
 handle _ = return ()
 
+-- |
+-- An event hook to handle applications that wish to fullscreen using the
+-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
+-- function, such as Totem, Evince and OpenOffice.org.
+fullscreenEventHook :: Event -> X All
+fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
+  state <- getAtom "_NET_WM_STATE"
+  fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
+  wstate <- fromMaybe [] `fmap` getProp32 state win
+
+  let isFull = fromIntegral fullsc `elem` wstate
+
+      -- Constants for the _NET_WM_STATE protocol:
+      remove = 0
+      add = 1
+      toggle = 2
+      ptype = 4 -- The atom property type for changeProperty
+      chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)
+
+  when (typ == state && fi fullsc `elem` dats) $ do
+    when (action == add || (action == toggle && not isFull)) $ do
+      chWstate (fi fullsc:)
+      windows $ W.float win $ W.RationalRect 0 0 1 1
+    when (action == remove || (action == toggle && isFull)) $ do
+      chWstate $ delete (fi fullsc)
+      windows $ W.sink win
+
+  return $ All True
+
+fullscreenEventHook _ = return $ All True
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do

XMonad/Hooks/FadeWindows.hs

@@ -0,0 +1,221 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.FadeWindows
+-- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>
+-- License     :  BSD
+--
+-- Maintainer  :  Brandon S Allbery KF8NH
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A more flexible and general compositing interface than FadeInactive.
+-- Windows can be selected and opacity specified by means of FadeHooks,
+-- which are very similar to ManageHooks and use the same machinery.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.FadeWindows (-- * Usage
+                                 -- $usage
+
+                                 -- * The 'logHook' for window fading
+                                 fadeWindowsLogHook
+
+                                 -- * The 'FadeHook'
+                                ,FadeHook
+                                ,Opacity
+                                ,idFadeHook
+
+                                 -- * Predefined 'FadeHook's
+                                ,opaque
+                                ,solid
+                                ,transparent
+                                ,invisible
+                                ,transparency
+                                ,translucence
+                                ,fadeBy
+                                ,opacity
+                                ,fadeTo
+
+                                -- * 'handleEventHook' for mapped/unmapped windows
+                                ,fadeWindowsEventHook
+
+                                -- * 'doF' for simple hooks
+                                ,doS
+
+                                -- * Useful 'Query's for 'FadeHook's
+                                ,isFloating
+                                ,isUnfocused
+                                ) where
+
+import           XMonad.Core
+import           XMonad.ManageHook                       (liftX)
+import qualified XMonad.StackSet             as W
+
+import           XMonad.Hooks.FadeInactive               (setOpacity
+                                                         ,isUnfocused
+                                                         )
+
+import           Control.Monad                           (forM_)
+import           Control.Monad.Reader                    (ask
+                                                         ,asks)
+import           Control.Monad.State                     (gets)
+import qualified Data.Map                    as M
+import           Data.Monoid
+
+import           Graphics.X11.Xlib.Extras                (Event(..))
+
+-- $usage
+-- To use this module, make sure your @xmonad@ core supports generalized
+-- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then
+-- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your
+-- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':
+--
+-- >     , logHook = fadeWindowsLogHook myFadeHook
+-- >     , handleEventHook = fadeWindowsEventHook
+-- >     {- ... -}
+-- >
+-- > myFadeHook = composeAll [isUnfocused --> transparency 0.2
+-- >                         ,                opaque
+-- >                         ]
+--
+-- The above is like FadeInactive with a fade value of 0.2.
+--
+-- FadeHooks do not accumulate; instead, they compose from right to
+-- left like 'ManageHook's, so the above example @myFadeHook@ will
+-- render unfocused windows at 4/5 opacity and the focused window
+-- as opaque.  The 'opaque' hook above is optional, by the way, as any
+-- unmatched window will be opaque by default.
+--
+-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
+-- exports a number of Queries that can be used in either @ManageHook@
+-- or @FadeHook@.
+--
+-- Note that you need a compositing manager such as @xcompmgr@,
+-- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you
+-- aren't running a compositing manager, the opacity will be recorded
+-- but won't take effect until a compositing manager is started.
+--
+-- For more detailed instructions on editing the 'logHook' see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the 'handleEventHook',
+-- see:
+--
+-- "XMonad.Doc.Extending#Editing_the_event_hook"
+-- (which sadly doesnt exist at the time of writing...)
+-- 
+-- /WARNING:/  This module is very good at triggering bugs in
+-- compositing managers.  Symptoms range from windows not being
+-- repainted until the compositing manager is restarted or the
+-- window is unmapped and remapped, to the machine becoming sluggish
+-- until the compositing manager is restarted (at which point a
+-- popup/dialog will suddenly appear; apparently it's getting into
+-- a tight loop trying to fade the popup in).  I find it useful to
+-- have a key binding to restart the compositing manager; for example,
+--
+-- main = xmonad $ defaultConfig {
+--                   {- ... -}
+--                 }
+--                 `additionalKeysP`
+--                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]
+--                 {- ... -}
+--                 ]
+--
+-- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)
+
+-- a window opacity to be carried in a Query.  OEmpty is sort of a hack
+-- to make it obay the monoid laws
+data Opacity = Opacity Rational | OEmpty
+
+instance Monoid Opacity where
+  mempty                  = OEmpty
+  r      `mappend` OEmpty = r
+  _      `mappend` r      = r
+
+-- | A FadeHook is similar to a ManageHook, but records window opacity.
+type FadeHook = Query Opacity
+
+-- | Render a window fully opaque.
+opaque :: FadeHook
+opaque =  doS (Opacity 1)
+
+-- | Render a window fully transparent.
+transparent :: FadeHook
+transparent =  doS (Opacity 0)
+
+-- | Specify a window's transparency.
+transparency :: Rational -- ^ The window's transparency as a fraction.
+                         --   @transparency 1@ is the same as 'transparent',
+                         --   whereas @transparency 0@ is the same as 'opaque'.
+             -> FadeHook
+transparency =  doS . Opacity . (1-) . clampRatio
+
+-- | Specify a window's opacity; this is the inverse of 'transparency'.
+opacity :: Rational -- ^ The opacity of a window as a fraction.
+                    --   @opacity 1@ is the same as 'opaque',
+                    --   whereas @opacity 0@ is the same as 'transparent'.
+        -> FadeHook
+opacity =  doS . Opacity . clampRatio
+
+fadeTo, translucence, fadeBy :: Rational -> FadeHook
+-- ^ An alias for 'transparency'.
+fadeTo       = transparency
+-- ^ An alias for 'transparency'.
+translucence = transparency
+-- ^ An alias for 'transparency'.
+fadeBy       = opacity
+
+invisible, solid :: FadeHook
+-- ^ An alias for 'transparent'.
+invisible    = transparent
+-- ^ An alias for 'opaque'.
+solid        = opaque
+
+-- | Like 'doF', but usable with 'ManageHook'-like hooks that
+-- aren't 'Query' wrapped around transforming functions ('Endo').
+doS :: Monoid m => m -> Query m
+doS =  return
+
+-- | The identity 'FadeHook', which renders windows 'opaque'.
+idFadeHook :: FadeHook
+idFadeHook =  opaque
+
+-- | A Query to determine if a window is floating.
+isFloating :: Query Bool
+isFloating =  ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
+
+-- boring windows can't be seen outside of a layout, so we watch messages with
+-- a dummy LayoutModifier and stow them in a persistent bucket.  this is not
+-- entirely reliable given that boringAuto still isn't observable; we just hope
+-- those aren't visible and won;t be affected anyway
+-- @@@ punted for now, will be a separate module.  it's still slimy, though
+
+-- | A 'logHook' to fade windows under control of a 'FadeHook', which is
+--   similar to but not identical to 'ManageHook'.
+fadeWindowsLogHook   :: FadeHook -> X ()
+fadeWindowsLogHook h =  withWindowSet $ \s -> do
+  let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
+                    concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
+  forM_ visibleWins $ \w -> do
+    o <- userCodeDef (Opacity 1) (runQuery h w)
+    setOpacity w $ case o of
+                     OEmpty    -> 0.93
+                     Opacity r -> r
+
+-- | A 'handleEventHook' to handle fading and unfading of newly mapped
+--   or unmapped windows; this avoids problems with layouts such as
+--   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may
+--   also be useful with "XMonad.Hooks.FadeInactive".
+fadeWindowsEventHook                     :: Event -> X All
+fadeWindowsEventHook (MapNotifyEvent {}) =
+  -- we need to run the fadeWindowsLogHook.  only one way...
+  asks config >>= logHook >> return (All True)
+fadeWindowsEventHook _                   =  return (All True)
+
+-- A utility to clamp opacity fractions to the range (0,1)
+clampRatio   :: Rational         -> Rational
+clampRatio r |  r >= 0 && r <= 1 =  r
+             |  r < 0            =  0
+             |  otherwise        =  1

XMonad/Hooks/FloatNext.hs

@@ -2,10 +2,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.FloatNext
--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
--- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -36,38 +36,11 @@ module XMonad.Hooks.FloatNext ( -- * Usage
                               , willFloatAllNewPP
                               , runLogHook ) where
 
-import Prelude hiding (all)
-
 import XMonad
-import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Hooks.ToggleHook
 
-import Control.Monad (join,guard)
-import Control.Applicative ((<$>))
-import Control.Arrow (first, second)
-
-{- Helper functions -}
-
-_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
-_set f b = modify' (f $ const b)
-
-_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
-_toggle f = modify' (f not)
-
-_get :: ((Bool, Bool) -> a) -> X a
-_get f = XS.gets (f . getFloatMode)
-
-_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
-_pp f s st = (\b -> guard b >> Just (st s)) <$> _get f
-
-{- The current state is kept here -}
-
-data FloatMode = FloatMode { getFloatMode :: (Bool,Bool) } deriving (Typeable)
-
-instance ExtensionClass FloatMode where
-    initialValue = FloatMode (False,False)
-
-modify' :: ((Bool,Bool) -> (Bool,Bool)) -> X ()
-modify' f = XS.modify (FloatMode . f . getFloatMode)
+hookName :: String
+hookName = "__float"
 
 -- $usage
 -- This module provides actions (that can be set as keybindings)
@@ -95,33 +68,31 @@ modify' f = XS.modify (FloatMode . f . getFloatMode)
 -- | This 'ManageHook' will selectively float windows as set
 -- by 'floatNext' and 'floatAllNew'.
 floatNextHook :: ManageHook
-floatNextHook = do (next, all) <- liftX $ XS.gets getFloatMode
-                   liftX $ XS.put $ FloatMode (False, all)
-                   if next || all then doFloat else idHook
+floatNextHook = toggleHook hookName doFloat
 
 -- | @floatNext True@ arranges for the next spawned window to be
 -- sent to the floating layer, @floatNext False@ cancels it.
 floatNext :: Bool -> X ()
-floatNext = _set first
+floatNext = hookNext hookName
 
 toggleFloatNext :: X ()
-toggleFloatNext = _toggle first
+toggleFloatNext = toggleHookNext hookName
 
 -- | @floatAllNew True@ arranges for new windows to be
 -- sent to the floating layer, @floatAllNew False@ cancels it
 floatAllNew :: Bool -> X ()
-floatAllNew = _set second
+floatAllNew = hookAllNew hookName
 
 toggleFloatAllNew :: X ()
-toggleFloatAllNew = _toggle second
+toggleFloatAllNew = toggleHookAllNew hookName
 
 -- | Whether the next window will be set floating
 willFloatNext :: X Bool
-willFloatNext = _get fst
+willFloatNext = willHookNext hookName
 
 -- | Whether new windows will be set floating
 willFloatAllNew :: X Bool
-willFloatAllNew = _get snd
+willFloatAllNew = willHookAllNew hookName
 
 -- $pp
 -- The following functions are used to display the current
@@ -143,10 +114,7 @@ willFloatAllNew = _get snd
 -- pass them 'id'.
 
 willFloatNextPP :: (String -> String) -> X (Maybe String)
-willFloatNextPP = _pp fst "Next"
+willFloatNextPP = willHookNextPP hookName
 
 willFloatAllNewPP :: (String -> String) -> X (Maybe String)
-willFloatAllNewPP = _pp snd "All"
-
-runLogHook :: X ()
-runLogHook = join $ asks $ logHook . config
+willFloatAllNewPP = willHookAllNewPP hookName

XMonad/Hooks/ICCCMFocus.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ICCCMFocus
+-- License      : BSD
+--
+-- Maintainer   : Tony Morris <haskell@tmorris.net>
+--
+-- Implemented in your @logHook@, Java swing applications will not misbehave
+-- when it comes to taking and losing focus.
+--
+-- This has been done by taking the patch in <http://code.google.com/p/xmonad/issues/detail?id=177> and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@.
+--
+-- @
+--    conf' =
+--      conf {
+--        logHook = takeTopFocus
+--      }
+-- @
+-----------------------------------------------------------------------------
+module XMonad.Hooks.ICCCMFocus
+(
+  atom_WM_TAKE_FOCUS  
+, takeFocusX
+, takeTopFocus
+) where
+
+import XMonad
+import XMonad.Hooks.SetWMName
+import qualified XMonad.StackSet as W
+import Control.Monad
+
+atom_WM_TAKE_FOCUS ::
+  X Atom
+atom_WM_TAKE_FOCUS =
+  getAtom "WM_TAKE_FOCUS"
+
+takeFocusX ::
+  Window
+  -> X ()
+takeFocusX w =
+  withWindowSet . const $ do
+    dpy       <- asks display
+    wmtakef   <- atom_WM_TAKE_FOCUS
+    wmprot    <- atom_WM_PROTOCOLS
+    protocols <- io $ getWMProtocols dpy w
+    when (wmtakef `elem` protocols) $
+      io . allocaXEvent $ \ev -> do
+          setEventType ev clientMessage
+          setClientMessageEvent ev w wmprot 32 wmtakef currentTime
+          sendEvent dpy w False noEventMask ev
+
+-- | The value to add to your log hook configuration.
+takeTopFocus ::
+  X ()
+takeTopFocus =
+  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"  
+

XMonad/Hooks/ManageDocks.hs

@@ -1,5 +1,4 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
 -- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
 -----------------------------------------------------------------------------
 -- |
@@ -18,10 +17,17 @@ module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
     manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docksEventHook,
     ToggleStruts(..),
     SetStruts(..),
     module XMonad.Util.Types,
 
+#ifdef TESTING
+    r2c,
+    c2r,
+    RectC(..),
+#endif
+
     -- for XMonad.Actions.FloatSnap
     calcGap
     ) where
@@ -30,10 +36,11 @@ module XMonad.Hooks.ManageDocks (
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
-import Control.Monad
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types
 import XMonad.Util.WindowProperties (getProp32s)
+import XMonad.Util.XUtils (fi)
+import Data.Monoid (All(..))
 
 import qualified Data.Set as S
 
@@ -56,6 +63,11 @@ import qualified Data.Set as S
 -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
 -- >                   where  tall = Tall 1 (3/100) (1/2)
 --
+-- The third component is an event hook that causes new docks to appear
+-- immediately, instead of waiting for the next focus change.
+--
+-- > handleEventHook = ... <+> docksEventHook
+--
 -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
 -- similar to:
 --
@@ -102,6 +114,14 @@ checkDock = ask >>= \w -> liftX $ do
         Just [r] -> return $ elem (fromIntegral r) [dock, desk]
         _        -> return False
 
+-- | Whenever a new dock appears, refresh the layout immediately to avoid the
+-- new dock.
+docksEventHook :: Event -> X All
+docksEventHook (MapNotifyEvent {ev_window = w}) = do
+    whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh
+    return (All True)
+docksEventHook _ = return (All True)
+
 -- | Gets the STRUT config, if present, in xmonad gap order
 getStrut :: Window -> X [Strut]
 getStrut w = do
@@ -210,32 +230,22 @@ type Strut = (Direction2D, CLong, CLong, CLong)
 -- | (Initial x pixel, initial y pixel,
 --    final x pixel, final y pixel).
 
-type RectC = (CLong, CLong, CLong, CLong)
-
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
+newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show)
 
 -- | Invertible conversion.
 
 r2c :: Rectangle -> RectC
-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
+r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
 
 -- | Invertible conversion.
 
 c2r :: RectC -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
+c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
 
--- TODO: Add these QuickCheck properties to the test suite, along with
--- suitable Arbitrary instances.
-
--- prop_r2c_c2r :: RectC -> Bool
--- prop_r2c_c2r r = r2c (c2r r) == r
-
--- prop_c2r_r2c :: Rectangle -> Bool
--- prop_c2r_r2c r = c2r (r2c r) == r
 
 reduce :: RectC -> Strut -> RectC -> RectC
-reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
+reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) =
+ RectC $ case s of
     L | p (y0, y1) && qh x1     -> (mx x0 sx0, y0       , x1       , y1       )
     R | p (y0, y1) && qv sx1 x0 -> (x0       , y0       , mn x1 sx1, y1       )
     U | p (x0, x1) && qh y1     -> (x0       , mx y0 sy0, x1       , y1       )

XMonad/Hooks/ManageHelpers.hs

@@ -45,7 +45,8 @@ module XMonad.Hooks.ManageHelpers (
     doSideFloat,
     doFloatAt,
     doFloatDep,
-    doHideIgnore
+    doHideIgnore,
+    Match,
 ) where
 
 import XMonad

XMonad/Hooks/Minimize.hs

@@ -0,0 +1,53 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.Minimize
+-- Copyright   :  (c) Justin Bogner 2010
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Handles window manager hints to minimize and restore windows. Use
+-- this with XMonad.Layout.Minimize.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.Minimize
+    ( -- * Usage
+      -- $usage
+      minimizeEventHook
+    ) where
+
+import Data.Monoid
+import Control.Monad(when)
+
+import XMonad
+import XMonad.Layout.Minimize
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.Minimize
+-- > import XMonad.Layout.Minimize
+-- >
+-- > myHandleEventHook = minimizeEventHook
+-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
+-- > main = xmonad defaultConfig { layoutHook = myLayout
+-- >                             , handleEventHook = myHandleEventHook }
+
+minimizeEventHook :: Event -> X All
+minimizeEventHook (ClientMessageEvent {ev_window = w,
+                                       ev_message_type = mt,
+                                       ev_data = dt}) = do
+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+    a_cs <- getAtom "WM_CHANGE_STATE"
+
+    when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)
+    when (mt == a_cs) $ do
+      let message = fromIntegral . head $ dt
+      when (message == normalState) $ sendMessage (RestoreMinimizedWin w)
+      when (message == iconicState) $ minimizeWindow w
+
+    return (All True)
+minimizeEventHook _ = return (All True)

XMonad/Hooks/Place.hs

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

XMonad/Hooks/PositionStoreHooks.hs

@@ -36,13 +36,15 @@ module XMonad.Hooks.PositionStoreHooks (
 import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Util.PositionStore
-import XMonad.Util.XUtils (fi)
+import XMonad.Hooks.ManageDocks
+import XMonad.Layout.Decoration
 
 import System.Random(randomRIO)
 import Control.Applicative((<$>))
 import Control.Monad(when)
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Set as S
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -50,9 +52,13 @@ import Data.Monoid
 -- > import XMonad.Hooks.PositionStoreHooks
 --
 -- and adding 'positionStoreManageHook' to your 'ManageHook' as well
--- as 'positionStoreEventHook' to your event hooks:
+-- as 'positionStoreEventHook' to your event hooks. To be accurate
+-- about window sizes, the module needs to know if any decoration is in effect.
+-- This is specified with the first argument: Supply 'Nothing' for no decoration,
+-- otherwise use 'Just defaultTheme' or similar to inform the module about the
+-- decoration theme used.
 --
--- > myManageHook = positionStoreManageHook <+> manageHook defaultConfig
+-- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig
 -- > myHandleEventHook = positionStoreEventHook
 -- >
 -- > main = xmonad defaultConfig { manageHook = myManageHook
@@ -60,11 +66,13 @@ import Data.Monoid
 -- >                             }
 --
 
-positionStoreManageHook :: ManageHook
-positionStoreManageHook = ask >>= liftX . positionStoreInit >> idHook
+positionStoreManageHook :: Maybe Theme -> ManageHook
+positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
 
-positionStoreInit :: Window -> X ()
-positionStoreInit w = withDisplay $ \d -> do
+positionStoreInit :: Maybe Theme -> Window -> X ()
+positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
+        let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current
+                                                    -- form - makes windows smaller to make room for it
         wa <- io $ getWindowAttributes d w
         ws <- gets windowset
         arbitraryOffsetX <- randomIntOffset
@@ -76,13 +84,16 @@ positionStoreInit w = withDisplay $ \d -> do
                                         (Rectangle (srX + fi arbitraryOffsetX)
                                                    (srY + fi arbitraryOffsetY)
                                                     (fi $ wa_width wa)
-                                                    (fi $ wa_height wa)) sr )
+                                                    (decoH + fi (wa_height wa))) sr )
             else do
                 sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
                 let sr = screenRect . W.screenDetail $ sc
+                sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound])    -- take docks into account, accepting
+                                                                                    -- a somewhat unfortunate inter-dependency
+                                                                                    -- with 'XMonad.Hooks.ManageDocks'
                 modifyPosStore (\ps -> posStoreInsert ps w
-                                        (Rectangle (fi $ wa_x wa) (fi $ wa_y wa)
-                                            (fi $ wa_width wa) (fi $ wa_height wa)) sr )
+                                        (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
+                                            (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
     where
         randomIntOffset :: X (Int)
         randomIntOffset = io $ randomRIO (42, 242)

XMonad/Hooks/RestoreMinimized.hs

@@ -8,9 +8,9 @@
 -- Stability   :  unstable
 -- Portability :  not portable
 --
--- Lets you restore minimized windows (see "XMonad.Layout.Minimize")
--- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
--- and WM_CHANGE_STATE).
+-- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized
+-- windows (see "XMonad.Layout.Minimize") by selecting them on a
+-- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).
 --
 -----------------------------------------------------------------------------
 

XMonad/Hooks/ScreenCorners.hs

@@ -0,0 +1,170 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ScreenCorners
+-- Copyright   :  (c) 2009 Nils Schweinsberg
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Run @X ()@ actions by touching the edge of your screen with your mouse.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ScreenCorners
+    (
+    -- * Usage
+    -- $usage
+
+    -- * Adding screen corners
+      ScreenCorner (..)
+    , addScreenCorner
+    , addScreenCorners
+
+    -- * Event hook
+    , screenCornerEventHook
+    ) where
+
+import Data.Monoid
+import Data.List (find)
+import XMonad
+import XMonad.Util.XUtils (fi)
+
+import qualified Data.Map as M
+import qualified XMonad.Util.ExtensibleState as XS
+
+data ScreenCorner = SCUpperLeft
+                  | SCUpperRight
+                  | SCLowerLeft
+                  | SCLowerRight
+                  deriving (Eq, Ord, Show)
+
+
+
+--------------------------------------------------------------------------------
+-- ExtensibleState modifications
+--------------------------------------------------------------------------------
+
+newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
+    deriving Typeable
+
+instance ExtensionClass ScreenCornerState where
+    initialValue = ScreenCornerState M.empty
+
+-- | Add one single @X ()@ action to a screen corner
+addScreenCorner :: ScreenCorner -> X () -> X ()
+addScreenCorner corner xF = do
+
+    ScreenCornerState m <- XS.get
+    (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
+
+                        Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
+                        Nothing           -> flip (,) xF `fmap` createWindowAt corner
+
+    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
+
+-- | Add a list of @(ScreenCorner, X ())@ tuples
+addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
+addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
+
+
+--------------------------------------------------------------------------------
+-- Xlib functions
+--------------------------------------------------------------------------------
+
+-- "Translate" a ScreenCorner to real (x,y) Positions
+createWindowAt :: ScreenCorner -> X Window
+createWindowAt SCUpperLeft = createWindowAt' 0 0
+createWindowAt SCUpperRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) 0
+
+createWindowAt SCLowerLeft = withDisplay $ \dpy ->
+    let h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' 0 (fi h)
+
+createWindowAt SCLowerRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+        h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) (fi h)
+
+-- Create a new X window at a (x,y) Position
+createWindowAt' :: Position -> Position -> X Window
+createWindowAt' x y = withDisplay $ \dpy -> io $ do
+
+    rootw <- rootWindow dpy (defaultScreen dpy)
+
+    let
+        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
+        attrmask = cWOverrideRedirect
+
+    w <- allocaSetWindowAttributes $ \attributes -> do
+
+        set_override_redirect attributes True
+        createWindow dpy        -- display
+                     rootw      -- parent window
+                     x          -- x
+                     y          -- y
+                     1          -- width
+                     1          -- height
+                     0          -- border width
+                     0          -- depth
+                     inputOnly  -- class
+                     visual     -- visual
+                     attrmask   -- valuemask
+                     attributes -- attributes
+
+    -- we only need mouse entry events
+    selectInput dpy w enterWindowMask
+    mapWindow dpy w
+    sync dpy False
+    return w
+
+
+--------------------------------------------------------------------------------
+-- Event hook
+--------------------------------------------------------------------------------
+
+-- | Handle screen corner events
+screenCornerEventHook :: Event -> X All
+screenCornerEventHook CrossingEvent { ev_window = win } = do
+
+    ScreenCornerState m <- XS.get
+
+    case M.lookup win m of
+         Just (_, xF) -> xF
+         Nothing      -> return ()
+
+    return (All True)
+
+screenCornerEventHook _ = return (All True)
+
+
+--------------------------------------------------------------------------------
+-- $usage
+--
+-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
+-- into one of your screen corners you can trigger an @X ()@ action, for
+-- example @"XMonad.Actions.GridSelect".goToSelected@ or
+-- @"XMonad.Actions.CycleWS".nextWS@ etc.
+--
+-- To use it, import it on top of your @xmonad.hs@:
+--
+-- > import XMonad.Hooks.ScreenCorners
+--
+-- Then add your screen corners in our startup hook:
+--
+-- > myStartupHook = do
+-- >     ...
+-- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
+-- >     addScreenCorners [ (SCLowerRight, nextWS)
+-- >                      , (SCLowerLeft,  prevWS)
+-- >                      ]
+--
+-- And finally wait for screen corner events in your event hook:
+--
+-- > myEventHook e = do
+-- >     ...
+-- >     screenCornerEventHook e

XMonad/Hooks/Script.hs

@@ -26,7 +26,6 @@ module XMonad.Hooks.Script (
 --
 import XMonad
 
-import Control.Monad.Trans
 import System.Directory
 
 -- $usage

XMonad/Hooks/ServerMode.hs

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

XMonad/Hooks/ToggleHook.hs

@@ -0,0 +1,169 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ToggleHook
+-- Copyright   :  Ben Boeckel <mathstuf@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Ben Boeckel <mathstuf@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Hook and keybindings for toggling hook behavior.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ToggleHook ( -- * Usage
+                                 -- $usage
+
+                                 -- * The hook
+                                 toggleHook
+                               , toggleHook'
+
+                                 -- * Actions
+                               , hookNext
+                               , toggleHookNext
+                               , hookAllNew
+                               , toggleHookAllNew
+
+                                 -- * Queries
+                               , willHook
+                               , willHookNext
+                               , willHookAllNew
+
+                                 -- * 'DynamicLog' utilities
+                                 -- $pp
+                               , willHookNextPP
+                               , willHookAllNewPP
+                               , runLogHook ) where
+
+import Prelude hiding (all)
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+
+import Control.Monad (join,guard)
+import Control.Applicative ((<$>))
+import Control.Arrow (first, second)
+
+import Data.Map
+
+{- Helper functions -}
+
+_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
+_set n f b = modify' n (f $ const b)
+
+_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
+_toggle n f = modify' n (f not)
+
+_get :: String -> ((Bool, Bool) -> a) -> X a
+_get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks)
+
+_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
+_pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
+
+{- The current state is kept here -}
+
+data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable)
+
+instance ExtensionClass HookState where
+    initialValue = HookState empty
+
+modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
+modify' n f = XS.modify (HookState . setter . hooks)
+    where
+        setter m = insert n (f (findWithDefault (False, False) n m)) m
+
+-- $usage
+-- This module provides actions (that can be set as keybindings)
+-- to be able to cause hooks to be occur on a conditional basis.
+--
+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.ToggleHook
+--
+-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
+-- name of the hook and @hook@ is the hook to execute based on the state.
+--
+-- > myManageHook = toggleHook "float" doFloat <+> manageHook defaultConfig
+--
+-- Additionally, toggleHook' is provided to toggle between two hooks (rather
+-- than on/off).
+--
+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig
+--
+-- The 'hookNext' and 'toggleHookNext' functions can be used in key
+-- bindings to set whether the hook is applied or not.
+--
+-- > , ((modm, xK_e), toggleHookNext "float")
+--
+-- 'hookAllNew' and 'toggleHookAllNew' are similar but float all
+-- spawned windows until disabled again.
+--
+-- > , ((modm, xK_r), toggleHookAllNew "float")
+
+-- | This 'ManageHook' will selectively apply a hook as set
+-- by 'hookNext' and 'hookAllNew'.
+toggleHook :: String -> ManageHook -> ManageHook
+toggleHook n h = toggleHook' n h idHook
+
+toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
+toggleHook' n th fh = do m <- liftX $ XS.gets hooks
+                         (next, all) <- return $ findWithDefault (False, False) n m
+                         liftX $ XS.put $ HookState $ insert n (False, all) m
+                         if next || all then th else fh
+
+-- | @hookNext name True@ arranges for the next spawned window to
+-- have the hook @name@ applied, @hookNext name False@ cancels it.
+hookNext :: String -> Bool -> X ()
+hookNext n = _set n first
+
+toggleHookNext :: String -> X ()
+toggleHookNext n = _toggle n first
+
+-- | @hookAllNew name True@ arranges for new windows to
+-- have the hook @name@ applied, @hookAllNew name False@ cancels it
+hookAllNew :: String -> Bool -> X ()
+hookAllNew n = _set n second
+
+toggleHookAllNew :: String -> X ()
+toggleHookAllNew n = _toggle n second
+
+-- | Query what will happen at the next ManageHook call for the hook @name@.
+willHook :: String -> X Bool
+willHook n = willHookNext n <||> willHookAllNew n
+
+-- | Whether the next window will trigger the hook @name@.
+willHookNext :: String -> X Bool
+willHookNext n = _get n fst
+
+-- | Whether new windows will trigger the hook @name@.
+willHookAllNew :: String -> X Bool
+willHookAllNew n = _get n snd
+
+-- $pp
+-- The following functions are used to display the current
+-- state of 'hookNext' and 'hookAllNew' in your
+-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.
+-- 'willHookNextPP' and 'willHookAllNewPP' should be added
+-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your
+-- 'XMonad.Hooks.DynamicLog.PP'.
+--
+-- Use 'runLogHook' to refresh the output of your 'logHook', so
+-- that the effects of a 'hookNext'/... will be visible
+-- immediately:
+--
+-- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook)
+--
+-- The @String -> String@ parameters to 'willHookNextPP' and
+-- 'willHookAllNewPP' will be applied to their output, you
+-- can use them to set the text color, etc., or you can just
+-- pass them 'id'.
+
+willHookNextPP :: String -> (String -> String) -> X (Maybe String)
+willHookNextPP n = _pp n fst "Next"
+
+willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
+willHookAllNewPP n = _pp n snd "All"
+
+runLogHook :: X ()
+runLogHook = join $ asks $ logHook . config

XMonad/Hooks/UrgencyHook.hs

@@ -65,7 +65,8 @@ module XMonad.Hooks.UrgencyHook (
                                  readUrgents, withUrgents,
                                  StdoutUrgencyHook(..),
                                  SpawnUrgencyHook(..),
-                                 UrgencyHook(urgencyHook)
+                                 UrgencyHook(urgencyHook),
+                                 Interval,
                                  ) where
 
 import XMonad
@@ -79,7 +80,7 @@ import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (testBit)
-import Data.List (delete)
+import Data.List (delete, (\\))
 import Data.Maybe (listToMaybe, maybeToList)
 import qualified Data.Set as S
 
@@ -372,7 +373,9 @@ shouldSuppress :: SuppressWhen -> Window -> X Bool
 shouldSuppress sw w = elem w <$> suppressibleWindows sw
 
 cleanupUrgents :: SuppressWhen -> X ()
-cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw
+cleanupUrgents sw = do
+    sw' <- suppressibleWindows sw
+    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
 
 suppressibleWindows :: SuppressWhen -> X [Window]
 suppressibleWindows Visible  = gets $ S.toList . mapped

XMonad/Hooks/XPropManage.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.XPropManage
@@ -17,14 +18,14 @@ module XMonad.Hooks.XPropManage (
                  xPropManageHook, XPropMatch, pmX, pmP
                  ) where
 
+import Prelude hiding (catch)
+import Control.Exception
 import Data.Char (chr)
-import Data.List (concat)
 import Data.Monoid (mconcat, Endo(..))
 
 import Control.Monad.Trans (lift)
 
 import XMonad
-import XMonad.ManageHook ((-->))
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -75,7 +76,7 @@ xPropManageHook tms = mconcat $ map propToHook tms
 
 getProp :: Display -> Window -> Atom -> X ([String])
 getProp d w p = do
-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
+    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
     let filt q | q == wM_COMMAND = concat . map splitAtNull
                | otherwise       = id
     return (filt p prop)

XMonad/Layout/Accordion.hs

@@ -42,7 +42,7 @@ data Accordion a = Accordion deriving ( Read, Show )
 instance LayoutClass Accordion Window where
     pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms
      where
-       ups    = W.up ws
+       ups    = reverse $ W.up ws
        dns    = W.down ws
        (top,  allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc
        (center,  bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop

XMonad/Layout/AutoMaster.hs

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

XMonad/Layout/BorderResize.hs

@@ -24,6 +24,7 @@ module XMonad.Layout.BorderResize
       -- $usage
       borderResize
     , BorderResize (..)
+    , RectWithBorders, BorderInfo,
     ) where
 
 import XMonad
@@ -63,15 +64,6 @@ brBorderOffset = 5
 brBorderSize :: Dimension
 brBorderSize = 10
 
-brCursorRightSide :: Glyph
-brCursorRightSide = 96
-brCursorLeftSide :: Glyph
-brCursorLeftSide = 70
-brCursorTopSide :: Glyph
-brCursorTopSide = 138
-brCursorBottomSide :: Glyph
-brCursorBottomSide = 16
-
 borderResize :: l a -> ModifiedLayout BorderResize l a
 borderResize = ModifiedLayout (BR M.empty)
 
@@ -155,10 +147,10 @@ createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList
 
 prepareBorders :: Rectangle -> [BorderBlueprint]
 prepareBorders (Rectangle x y wh ht) =
-    [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), brCursorRightSide     , RightSideBorder),
-     ((Rectangle (x - brBorderOffset) y brBorderSize ht)        , brCursorLeftSide      , LeftSideBorder),
-     ((Rectangle x (y - brBorderOffset) wh brBorderSize)        , brCursorTopSide       , TopSideBorder),
-     ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), brCursorBottomSide    , BottomSideBorder)
+    [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder),
+     ((Rectangle (x - brBorderOffset) y brBorderSize ht)        , xC_left_side  , LeftSideBorder),
+     ((Rectangle x (y - brBorderOffset) wh brBorderSize)        , xC_top_side   , TopSideBorder),
+     ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder)
     ]
 
 handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()

XMonad/Layout/BoringWindows.hs

@@ -24,6 +24,10 @@ module XMonad.Layout.BoringWindows (
                                    UpdateBoring(UpdateBoring),
                                    BoringMessage(Replace,Merge),
                                    BoringWindows()
+
+                                   -- * Tips
+                                   -- ** variant of 'Full'
+                                   -- $simplest
                                   ) where
 
 import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
@@ -134,3 +138,12 @@ instance LayoutModifier BoringWindows Window where
 focusMaster' :: W.Stack a -> W.Stack a
 focusMaster' c@(W.Stack _ [] _) = c
 focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
+
+{- $simplest
+
+An alternative to 'Full' is "XMonad.Layout.Simplest".  Less windows are
+ignored by 'focusUp' and 'focusDown'. This may be helpful when you want windows
+to be uninteresting by some other layout modifier (ex.
+"XMonad.Layout.Minimize")
+
+-}

XMonad/Layout/ButtonDecoration.hs

@@ -22,7 +22,8 @@
 module XMonad.Layout.ButtonDecoration
     ( -- * Usage:
       -- $usage
-      buttonDeco
+      buttonDeco,
+      ButtonDecoration,
     ) where
 
 import XMonad

XMonad/Layout/CenteredMaster.hs

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

XMonad/Layout/Column.hs

@@ -61,9 +61,9 @@ columnLayout (Column q) rect stack = zip ws rects
 
 mkRect :: Rectangle -> (Dimension,Position) -> Rectangle
 mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h
-        
+
 xn :: Int -> Rectangle -> Float -> Int -> Dimension
-xn n (Rectangle _ _ _ h) q k = if q==1 then 
+xn n (Rectangle _ _ _ h) q k = if q==1 then
                                   h `div` (fromIntegral n)
                                else
                                   round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))

XMonad/Layout/ComboP.hs

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

XMonad/Layout/Decoration.hs

@@ -27,6 +27,7 @@ module XMonad.Layout.Decoration
     , isInStack, isVisible, isInvisible, isWithin, fi
     , findWindowByDecoration
     , module XMonad.Layout.LayoutModifier
+    , DecorationState, OrigWin
     ) where
 
 import Control.Monad (when)
@@ -43,6 +44,7 @@ import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Invisible
 import XMonad.Util.XUtils
 import XMonad.Util.Font
+import XMonad.Util.Image
 
 -- $usage
 -- This module is intended for layout developers, who want to decorate
@@ -66,19 +68,22 @@ decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)
 --
 -- For a collection of 'Theme's see "XMonad.Util.Themes"
 data Theme =
-    Theme { activeColor         :: String    -- ^ Color of the active window
-          , inactiveColor       :: String    -- ^ Color of the inactive window
-          , urgentColor         :: String    -- ^ Color of the urgent window
-          , activeBorderColor   :: String    -- ^ Color of the border of the active window
-          , inactiveBorderColor :: String    -- ^ Color of the border of the inactive window
-          , urgentBorderColor   :: String    -- ^ Color of the border of the urgent window
-          , activeTextColor     :: String    -- ^ Color of the text of the active window
-          , inactiveTextColor   :: String    -- ^ Color of the text of the inactive window
-          , urgentTextColor     :: String    -- ^ Color of the text of the urgent window
-          , fontName            :: String    -- ^ Font name
-          , decoWidth           :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
-          , decoHeight          :: Dimension -- ^ Height of the decorations
-          , windowTitleAddons   :: [(String, Align)] -- ^ Extra text to appear in a window's title bar
+    Theme { activeColor        :: String                   -- ^ Color of the active window
+          , inactiveColor       :: String                   -- ^ Color of the inactive window
+          , urgentColor         :: String                   -- ^ Color of the urgent window
+          , activeBorderColor   :: String                   -- ^ Color of the border of the active window
+          , inactiveBorderColor :: String                   -- ^ Color of the border of the inactive window
+          , urgentBorderColor   :: String                   -- ^ Color of the border of the urgent window
+          , activeTextColor     :: String                   -- ^ Color of the text of the active window
+          , inactiveTextColor   :: String                   -- ^ Color of the text of the inactive window
+          , urgentTextColor     :: String                   -- ^ Color of the text of the urgent window
+          , fontName            :: String                   -- ^ Font name
+          , decoWidth           :: Dimension                -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
+          , decoHeight          :: Dimension                -- ^ Height of the decorations
+          , windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.
+                                                           --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"
+          , windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.
+                                                           --    Inner @[Bool]@ is a row in a icon bitmap.
           } deriving (Show, Read)
 
 -- | The default xmonad 'Theme'.
@@ -97,6 +102,7 @@ defaultTheme =
           , decoWidth           = 200
           , decoHeight          = 20
           , windowTitleAddons   = []
+          , windowTitleIcons    = []
           }
 
 -- | A 'Decoration' layout modifier will handle 'SetTheme', a message
@@ -362,7 +368,7 @@ createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in
                        createNewWindow r mask (inactiveColor t) True
 
 showDecos :: [DecoWin] -> X ()
-showDecos = showWindows . catMaybes . map fst
+showDecos = showWindows . catMaybes . map fst . filter (isJust . snd)
 
 hideDecos :: [DecoWin] -> X ()
 hideDecos = hideWindows . catMaybes . map fst
@@ -393,7 +399,9 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
                                   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
   let als = AlignCenter : map snd (windowTitleAddons t)
       strs = name : map fst (windowTitleAddons t)
-  paintAndWrite dw fs wh ht 1 bc borderc tc bc als strs
+      i_als = map snd (windowTitleIcons t)
+      icons = map fst (windowTitleIcons t)
+  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons
 updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
 updateDeco _ _ _ _ = return ()
 

XMonad/Layout/DecorationAddons.hs

@@ -29,7 +29,6 @@ import XMonad.Layout.Maximize
 import XMonad.Hooks.ManageDocks
 import XMonad.Util.Font
 import XMonad.Util.PositionStore
-import XMonad.Util.XUtils (fi)
 
 import Control.Applicative((<$>))
 import Data.Maybe
@@ -63,7 +62,7 @@ titleBarButtonHandler mainw distFromLeft distFromRight = do
                              then focus mainw >> sendMessage (maximizeRestore mainw) >> return True
                   else if (fi distFromRight >= minimizeButtonOffset &&
                            fi distFromRight <= minimizeButtonOffset + buttonSize)
-                             then focus mainw >> sendMessage (MinimizeWin mainw) >> return True
+                             then focus mainw >> minimizeWindow mainw >> return True
                   else return False
     action
 
@@ -88,7 +87,7 @@ handleScreenCrossing w decoWin = withDisplay $ \d -> do
     ws <- gets windowset
     sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py)
     maybeWksp <- screenWorkspace $ W.screen sc
-    let targetWksp = maybeWksp >>= \wksp -> 
+    let targetWksp = maybeWksp >>= \wksp ->
                         W.findTag w ws >>= \currentWksp ->
                         if (currentWksp /= wksp)
                             then Just wksp

XMonad/Layout/DecorationMadness.hs

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

XMonad/Layout/Dishes.hs

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

XMonad/Layout/DraggingVisualizer.hs

@@ -17,7 +17,8 @@
 
 module XMonad.Layout.DraggingVisualizer
     ( draggingVisualizer,
-      DraggingVisualizerMsg (..)
+      DraggingVisualizerMsg (..),
+      DraggingVisualizer,
     ) where
 
 import XMonad

XMonad/Layout/Drawer.hs

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

XMonad/Layout/Fullscreen.hs

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

XMonad/Layout/Gaps.hs

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

XMonad/Layout/GridVariants.hs

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

XMonad/Layout/Groups.hs

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

XMonad/Layout/Groups/Examples.hs

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

XMonad/Layout/Groups/Helpers.hs

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

XMonad/Layout/Groups/Wmii.hs

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

XMonad/Layout/HintedGrid.hs

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

XMonad/Layout/IM.hs

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

XMonad/Layout/ImageButtonDecoration.hs

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

XMonad/Layout/IndependentScreens.hs

@@ -19,18 +19,23 @@ module XMonad.Layout.IndependentScreens (
     VirtualWorkspace, PhysicalWorkspace,
     workspaces',
     withScreens, onCurrentScreen,
+    marshallPP,
     countScreens,
-    marshall, unmarshall
+    -- * Converting between virtual and physical workspaces
+    -- $converting
+    marshall, unmarshall, unmarshallS, unmarshallW,
+    marshallWindowSpace, unmarshallWindowSpace
 ) where
 
 -- for the screen stuff
+import Control.Applicative((<*), liftA2)
 import Control.Arrow hiding ((|||))
 import Control.Monad
-import Control.Monad.Instances
 import Data.List
 import Graphics.X11.Xinerama
 import XMonad
-import XMonad.StackSet hiding (workspaces)
+import XMonad.StackSet hiding (filter, workspaces)
+import XMonad.Hooks.DynamicLog
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -48,15 +53,19 @@ import XMonad.StackSet hiding (workspaces)
 -- to specific workspace names.  In the default configuration, only
 -- the keybindings for changing workspace do this:
 --
--- > [((m .|. modm, k), windows $ f i)
--- >     | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
--- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+-- > keyBindings conf = let m = modMask conf in fromList $
+-- >     {- lots of other keybindings -}
+-- >     [((m .|. modm, k), windows $ f i)
+-- >         | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
+-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
 --
 -- This should change to
 --
--- > [((m .|. modm, k), windows $ onCurrentScreen f i)
--- >     | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
--- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+-- > keyBindings conf = let m = modMask conf in fromList $
+-- >     {- lots of other keybindings -}
+-- >     [((m .|. modm, k), windows $ onCurrentScreen f i)
+-- >         | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
+-- >         , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
 --
 -- In particular, the analogue of @XMonad.workspaces@ is
 -- @workspaces'@, and you can use @onCurrentScreen@ to convert functions
@@ -67,17 +76,24 @@ import XMonad.StackSet hiding (workspaces)
 type VirtualWorkspace  = WorkspaceId
 type PhysicalWorkspace = WorkspaceId
 
+-- $converting
+-- You shouldn't need to use the functions below very much. They are used
+-- internally. However, in some cases, they may be useful, and so are exported
+-- just in case. In general, the \"marshall\" functions convert the convenient
+-- form (like \"web\") you would like to use in your configuration file to the
+-- inconvenient form (like \"2_web\") that xmonad uses internally. Similarly,
+-- the \"unmarshall\" functions convert in the other direction.
+
 marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace
 marshall (S sc) vws = show sc ++ '_':vws
 
-unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)
-unmarshall = ((S . read) *** drop 1) . break (=='_')
+unmarshall  :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)
+unmarshallS :: PhysicalWorkspace -> ScreenId
+unmarshallW :: PhysicalWorkspace -> VirtualWorkspace
 
--- ^ You shouldn't need to use @marshall@ and @unmarshall@ very much.
--- They simply convert between the physical and virtual worlds.  For
--- example, you might want to use them as part of a status bar
--- configuration.  The function @snd . unmarshall@ would discard the
--- screen information from an otherwise unsightly workspace name.
+unmarshall  = ((S . read) *** drop 1) . break (=='_')
+unmarshallS = fst . unmarshall
+unmarshallW = snd . unmarshall
 
 workspaces' :: XConfig l -> [VirtualWorkspace]
 workspaces' = nub . map (snd . unmarshall) . workspaces
@@ -101,4 +117,39 @@ onCurrentScreen f vws = screen . current >>= f . flip marshall vws
 -- >     }
 --
 countScreens :: (MonadIO m, Integral i) => m i
-countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo
+countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
+
+-- | This turns a naive pretty-printer into one that is aware of the
+-- independent screens. That is, you can write your pretty printer to behave
+-- the way you want on virtual workspaces; this function will convert that
+-- pretty-printer into one that first filters out physical workspaces on other
+-- screens, then converts all the physical workspaces on this screen to their
+-- virtual names.
+--
+-- For example, if you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write
+--
+-- > logHook = let log screen handle = dynamicLogWithPP . marshallPP screen . pp $ handle
+-- >           in log 0 hLeft >> log 1 hRight
+marshallPP :: ScreenId -> PP -> PP
+marshallPP s pp = pp {
+    ppCurrent           = ppCurrent         pp . snd . unmarshall,
+    ppVisible           = ppVisible         pp . snd . unmarshall,
+    ppHidden            = ppHidden          pp . snd . unmarshall,
+    ppHiddenNoWindows   = ppHiddenNoWindows pp . snd . unmarshall,
+    ppUrgent            = ppUrgent          pp . snd . unmarshall,
+    ppSort              = fmap (marshallSort s) (ppSort pp)
+    }
+
+marshallSort :: ScreenId -> ([WindowSpace] -> [WindowSpace]) -> ([WindowSpace] -> [WindowSpace])
+marshallSort s vSort = pScreens . vSort . vScreens where
+    onScreen ws = unmarshallS (tag ws) == s
+    vScreens    = map unmarshallWindowSpace . filter onScreen
+    pScreens    = map (marshallWindowSpace s)
+
+-- | Convert the tag of the 'WindowSpace' from a 'VirtualWorkspace' to a 'PhysicalWorkspace'.
+marshallWindowSpace   :: ScreenId -> WindowSpace -> WindowSpace
+-- | Convert the tag of the 'WindowSpace' from a 'PhysicalWorkspace' to a 'VirtualWorkspace'.
+unmarshallWindowSpace :: WindowSpace -> WindowSpace
+
+marshallWindowSpace s ws = ws { tag = marshall s  (tag ws) }
+unmarshallWindowSpace ws = ws { tag = unmarshallW (tag ws) }

XMonad/Layout/LayoutBuilder.hs

@@ -24,15 +24,13 @@ module XMonad.Layout.LayoutBuilder (
   SubMeasure (..),
   SubBox (..),
   absBox,
-  relBox
+  relBox,
+  LayoutN,
 ) where
 
 import XMonad
-import XMonad.Layout
 import qualified XMonad.StackSet as W
-import Graphics.X11.Xlib
 import Data.Maybe (isJust)
-import Control.Monad
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:

XMonad/Layout/LayoutBuilderP.hs

@@ -0,0 +1,210 @@
+{-# LANGUAGE TypeSynonymInstances, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable, ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.LayoutBuilderP
+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>, 2011 Ilya Portnov <portnov84@rambler.ru>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout combinator that sends windows matching given predicate to one rectangle
+-- and the rest to another.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.LayoutBuilderP (
+  LayoutP (..),
+  layoutP, layoutAll,
+  B.relBox, B.absBox,
+  -- * Overloading ways to select windows
+  -- $selectWin
+  Predicate (..), Proxy(..),
+  ) where
+
+import Control.Monad
+import Data.Maybe (isJust)
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Util.WindowProperties
+
+import qualified XMonad.Layout.LayoutBuilder as B
+
+-- $selectWin
+--
+-- 'Predicate' exists because layouts are required to be serializable, and
+-- "XMonad.Util.WindowProperties" is not sufficient (for example it does not
+-- allow using regular expressions).
+--
+-- compare "XMonad.Util.Invisible"
+
+-- | Type class for predicates. This enables us to manage not only Windows, 
+-- but any objects, for which instance Predicate is defined.
+--
+-- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras
+class Predicate p w where
+  alwaysTrue :: Proxy w -> p         -- ^ A predicate that is always True.
+  checkPredicate :: p -> w -> X Bool -- ^ Check if given object (window or smth else) matches that predicate
+
+-- | Contains no actual data, but is needed to help select the correct instance
+-- of 'Predicate'
+data Proxy a = Proxy
+
+-- | Data type for our layout.
+data LayoutP p l1 l2 a =
+    LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
+    deriving (Show,Read)
+
+-- | Use the specified layout in the described area windows that match given predicate and send the rest of the windows to the next layout in the chain.
+--   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.
+layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
+       p
+    -> B.SubBox                       -- ^ The box to place the windows in
+    -> Maybe B.SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left
+    -> l1 a                         -- ^ The layout to use in the specified area
+    -> LayoutP p l2 l3 a              -- ^ Where to send the remaining windows
+    -> LayoutP p l1 (LayoutP p l2 l3) a -- ^ The resulting layout
+layoutP prop box mbox sub next = LayoutP Nothing Nothing prop box mbox sub (Just next)
+
+-- | Use the specified layout in the described area for all remaining windows.
+layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
+       B.SubBox             -- ^ The box to place the windows in
+    -> l1 a               -- ^ The layout to use in the specified area
+    -> LayoutP p l1 Full a  -- ^ The resulting layout
+layoutAll box sub =
+  let a = alwaysTrue (Proxy :: Proxy a)
+  in  LayoutP Nothing Nothing a box Nothing sub Nothing
+
+instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
+    LayoutClass (LayoutP p l1 l2) w where
+
+        -- | Update window locations.
+        runLayout (W.Workspace _ (LayoutP subf nextf prop box mbox sub next) s) rect
+            = do (subs,nexts,subf',nextf') <- splitStack s prop subf nextf
+                 let selBox = if isJust nextf'
+                                then box
+                                else maybe box id mbox
+
+                 (sublist,sub') <- handle sub subs $ calcArea selBox rect
+
+                 (nextlist,next') <- case next of Nothing -> return ([],Nothing)
+                                                  Just n -> do (res,l) <- handle n nexts rect
+                                                               return (res,Just l)
+
+                 return (sublist++nextlist, Just $ LayoutP subf' nextf' prop box mbox sub' next' )
+              where
+                  handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r
+                                     l' <- return $ maybe l id ml
+                                     return (res,l')
+
+        -- |  Propagate messages.
+        handleMessage l m
+            | Just (IncMasterN _) <- fromMessage m = sendFocus l m
+            | Just (Shrink) <- fromMessage m = sendFocus l m
+            | Just (Expand) <- fromMessage m = sendFocus l m
+            | otherwise = sendBoth l m
+
+        -- |  Descriptive name for layout.
+        description (LayoutP _ _ _ _ _ sub (Just next)) = "layoutP "++ description sub ++" "++ description next
+        description (LayoutP _ _ _ _ _ sub Nothing)     = "layoutP "++ description sub
+
+
+sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+        => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendSub (LayoutP subf nextf prop box mbox sub next) m =
+    do sub' <- handleMessage sub m
+       return $ if isJust sub'
+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') next
+                else Nothing
+
+sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendBoth l@(LayoutP _ _ _ _ _ _ Nothing) m = sendSub l m
+sendBoth (LayoutP subf nextf prop box mbox sub (Just next)) m =
+    do sub' <- handleMessage sub m
+       next' <- handleMessage next m
+       return $ if isJust sub' || isJust next'
+                then Just $ LayoutP subf nextf prop box mbox (maybe sub id sub') (Just $ maybe next id next')
+                else Nothing
+
+sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+         => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendNext (LayoutP _ _ _ _ _ _ Nothing) _ = return Nothing
+sendNext (LayoutP subf nextf prop box mbox sub (Just next)) m =
+    do next' <- handleMessage next m
+       return $ if isJust next'
+                then Just $ LayoutP subf nextf prop box mbox sub next'
+                else Nothing
+
+sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
+          => LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
+sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
+                                              if foc then sendSub l m
+                                                     else sendNext l m
+
+isFocus :: (Show a) => Maybe a -> X Bool
+isFocus Nothing = return False
+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+                      return $ maybe False (\s -> show w == (show $ W.focus s)) ms
+
+
+-- | Split given list of objects (i.e. windows) using predicate.
+splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
+splitBy prop ws = foldM step ([], []) ws
+  where
+    step (good, bad) w = do
+      ok <- checkPredicate prop w
+      return $ if ok
+                then (w:good, bad)
+                else (good,   w:bad)
+
+splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
+splitStack Nothing _ _ _ = return (Nothing,Nothing,Nothing,Nothing)
+splitStack (Just s) prop subf nextf = do
+    let ws = W.integrate s
+    (good, other) <- splitBy prop ws
+    let subf'  = foc good subf
+        nextf' = foc other nextf
+    return ( differentiate' subf' good
+           , differentiate' nextf' other
+           , subf'
+           , nextf'
+           )
+  where
+    foc [] _ = Nothing
+    foc l f = if W.focus s `elem` l
+              then Just $ W.focus s
+              else if maybe False (`elem` l) f
+                   then f
+                   else Just $ head l
+
+calcArea :: B.SubBox -> Rectangle -> Rectangle
+calcArea (B.SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'
+    where
+        xpos' = calc False xpos $ rect_width rect
+        ypos' = calc False ypos $ rect_height rect
+        width' = calc True width $ rect_width rect - xpos'
+        height' = calc True height $ rect_height rect - ypos'
+
+        calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $
+            case val of B.Rel v -> floor $ v * fromIntegral tot
+                        B.Abs v -> if v<0 || (zneg && v==0)
+                                 then (fromIntegral tot)+v
+                                 else v
+
+differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
+differentiate' _ [] = Nothing
+differentiate' Nothing w = W.differentiate w
+differentiate' (Just f) w
+    | f `elem` w = Just $ W.Stack { W.focus = f
+                                  , W.up    = reverse $ takeWhile (/=f) w
+                                  , W.down  = tail $ dropWhile (/=f) w
+                                  }
+    | otherwise = W.differentiate w
+
+instance Predicate Property Window where
+  alwaysTrue _ = Const True
+  checkPredicate = hasProperty
+

XMonad/Layout/LayoutCombinators.hs

@@ -47,6 +47,9 @@ module XMonad.Layout.LayoutCombinators
       -- $jtl
     , (|||)
     , JumpToLayout(..)
+
+      -- * Types
+    , NewSelect
     ) where
 
 import Data.Maybe ( isJust, isNothing )
@@ -76,6 +79,7 @@ import XMonad.Layout.DragPane
 -- > import XMonad hiding ( (|||) )
 -- > import XMonad.Layout.LayoutCombinators
 --
+-- If you import XMonad.Layout, you will need to hide it from there as well.
 -- Then bind some keys to a 'JumpToLayout' message:
 --
 -- >   , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")  -- jump directly to the Full layout
@@ -179,9 +183,16 @@ infixr 5 |||
 -- The standard xmonad core exports a layout combinator @|||@ which
 -- represents layout choice.  This is a reimplementation which also
 -- provides the capability to support 'JumpToLayout' messages.  To use
--- it, be sure to hide the import of @|||@ from the xmonad core:
+-- it, be sure to hide the import of @|||@ from the xmonad core; if either of
+-- these two lines appear in your configuration:
+--
+-- > import XMonad
+-- > import XMonad.Layout
+--
+-- replace them with these instead, respectively:
 --
 -- > import XMonad hiding ( (|||) )
+-- > import XMonad.Layout hiding ( (|||) )
 --
 -- The argument given to a 'JumpToLayout' message should be the
 -- @description@ of the layout to be selected.  If you use
@@ -213,7 +224,7 @@ infixr 5 |||
 
 data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )
 
--- | 
+-- |
 data JumpToLayout = JumpToLayout String -- ^ A message to jump to a particular layout
                                         -- , specified by its description string..
                   | NextLayoutNoWrap

XMonad/Layout/LayoutHints.hs

@@ -20,10 +20,15 @@ module XMonad.Layout.LayoutHints
     , layoutHintsWithPlacement
     , layoutHintsToCenter
     , LayoutHints
+    , LayoutHintsToCenter
+    , hintsEventHook
     )  where
 
 import XMonad(LayoutClass(runLayout), mkAdjust, Window,
-              Dimension, Position, Rectangle(Rectangle),D)
+              Dimension, Position, Rectangle(Rectangle), D,
+              X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,
+              (<&&>), io, applySizeHints, whenX, isClient, withDisplay,
+              getWindowAttributes, getWMNormalHints, WindowAttributes(..))
 import qualified XMonad.StackSet as W
 
 import XMonad.Layout.Decoration(isInStack)
@@ -32,9 +37,10 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
 import XMonad.Util.Types(Direction2D(..))
 import Control.Applicative((<$>))
 import Control.Arrow(Arrow((***), first, second))
-import Control.Monad(Monad(return), mapM, join)
+import Control.Monad(join)
 import Data.Function(on)
 import Data.List(sortBy)
+import Data.Monoid(All(..))
 
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -62,6 +68,14 @@ import qualified Data.Set as Set
 -- For more detailed instructions on editing the layoutHook see:
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
+--
+-- To make XMonad reflect changes in window hints immediately, add
+-- 'hintsEventHook' to your 'handleEventHook'.
+--
+-- > myHandleEventHook = hintsEventHook <+> ...
+-- >
+-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook
+-- >                             , ... }
 
 layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a
 layoutHints = ModifiedLayout (LayoutHints (0, 0))
@@ -235,3 +249,19 @@ centerPlacement' cf root assigned
     = (cf $ cx - cwx, cf $ cy - cwy)
     where (cx,cy) = center root
           (cwx,cwy) = center assigned
+
+-- | Event hook that refreshes the layout whenever a window changes its hints.
+hintsEventHook :: Event -> X All
+hintsEventHook (PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w })
+    | t == propertyNotify && a == wM_NORMAL_HINTS = do
+        whenX (isClient w <&&> hintsMismatch w) $ refresh
+        return (All True)
+hintsEventHook _ = return (All True)
+
+-- | True if the window's current size does not satisfy its size hints.
+hintsMismatch :: Window -> X Bool
+hintsMismatch w = withDisplay $ \d -> io $ do
+    wa <- getWindowAttributes d w
+    sh <- getWMNormalHints d w
+    let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
+    return $ dim /= applySizeHints 0 sh dim

XMonad/Layout/LayoutModifier.hs

@@ -29,6 +29,8 @@ module XMonad.Layout.LayoutModifier (
     LayoutModifier(..), ModifiedLayout(..)
     ) where
 
+import Control.Monad
+
 import XMonad
 import XMonad.StackSet ( Stack, Workspace (..) )
 
@@ -106,6 +108,22 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
                  -> X ([(a, Rectangle)], Maybe (l a))
     modifyLayout _ w r = runLayout w r
 
+    -- | Similar to 'modifyLayout', but this function also allows you
+    -- update the state of your layout modifier(the second value in the
+    -- outer tuple).
+    --
+    -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a
+    -- modified state of the layout modifier, 'redoLayout' takes
+    -- precedence. If this function returns a modified state, this
+    -- state will internally be used in the subsequent call to
+    -- 'redoLayout' as well.
+    modifyLayoutWithUpdate :: (LayoutClass l a) =>
+                              m a
+                           -> Workspace WorkspaceId (l a) a
+                           -> Rectangle
+                           -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
+    modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r
+
     -- | 'handleMess' allows you to spy on messages to the underlying
     --   layout, in order to have an effect in the X monad, or alter
     --   the layout modifier state in some way (by returning @Just
@@ -234,9 +252,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
 --   semantics of a 'LayoutModifier' applied to an underlying layout.
 instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
     runLayout (Workspace i (ModifiedLayout m l) ms) r =
-        do (ws, ml')  <- modifyLayout m (Workspace i l ms) r
-           (ws', mm') <- redoLayout m r ms ws
-           let ml'' = case mm' of
+        do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r
+           (ws', mm'') <- redoLayout (maybe m id mm') r ms ws
+           let ml'' = case mm'' `mplus` mm' of
                         Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
                         Nothing -> ModifiedLayout m `fmap` ml'
            return (ws', ml'')

XMonad/Layout/LayoutScreens.hs

@@ -16,7 +16,8 @@
 module XMonad.Layout.LayoutScreens (
                                     -- * Usage
                                     -- $usage
-                                    layoutScreens, fixedLayout
+                                    layoutScreens, layoutSplitScreen, fixedLayout,
+                                    FixedLayout,
                                    ) where
 
 import XMonad
@@ -55,6 +56,7 @@ import qualified XMonad.StackSet as W
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+-- | Modify all screens.
 layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
 layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
 layoutScreens nscr l =
@@ -67,6 +69,20 @@ layoutScreens nscr l =
                   , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss
                   , W.hidden  = ys }
 
+-- | Modify current screen.
+layoutSplitScreen :: LayoutClass l Int => Int -> l Int -> X ()
+layoutSplitScreen nscr _ | nscr < 1 = trace $ "Can't layoutSplitScreen with only " ++ show nscr ++ " screens."
+layoutSplitScreen nscr l =
+    do rect <- gets $ screenRect . W.screenDetail . W.current . windowset
+       (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rect
+       windows $ \ws@(W.StackSet { W.current = c, W.visible = vs, W.hidden = hs }) ->
+           let (x:xs, ys) = splitAt nscr $ W.workspace c : hs
+               s:ss = map snd wss
+           in  ws { W.current = W.Screen x (W.screen c) (SD s)
+                  , W.visible = (zipWith3 W.Screen xs [(W.screen c+1) ..] $ map SD ss) ++
+                                map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs
+                  , W.hidden  = ys }
+
 getWindowRectangle :: Window -> X Rectangle
 getWindowRectangle w = withDisplay $ \d ->
     do a <- io $ getWindowAttributes d w

XMonad/Layout/LimitWindows.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}
+{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.LimitWindows
@@ -23,13 +23,20 @@ module XMonad.Layout.LimitWindows (
     limitWindows,limitSlice,limitSelect,
 
     -- * Change the number of windows
-    increaseLimit,decreaseLimit,setLimit
+    increaseLimit,decreaseLimit,setLimit,
+
+#ifdef TESTING
+    -- * For tests
+    select,update,Selection(..),updateAndSelect,
+#endif
+
+    -- * Types
+    LimitWindows, Selection,
     ) where
 
 import XMonad.Layout.LayoutModifier
 import XMonad
 import qualified XMonad.StackSet as W
-import XMonad.Layout (IncMasterN (..))
 import Control.Monad((<=<),guard)
 import Control.Applicative((<$>))
 import Data.Maybe(fromJust)
@@ -139,7 +146,7 @@ select s stk
         downs = W.down stk
         ups = reverse $ W.up stk
         lups = length ups
-    
+
 updateStart :: Selection l -> W.Stack a -> Int
 updateStart s stk
     | lups < nMaster s  -- the focussed window is in the master pane

XMonad/Layout/MagicFocus.hs

@@ -20,7 +20,8 @@ module XMonad.Layout.MagicFocus
      promoteWarp,
      promoteWarp',
      followOnlyIf,
-     disableFollowOnWS
+     disableFollowOnWS,
+     MagicFocus,
     ) where
 
 import XMonad

XMonad/Layout/Magnifier.hs

@@ -26,12 +26,14 @@ module XMonad.Layout.Magnifier
       magnifiercz,
       magnifiercz',
       maximizeVertical,
-      MagnifyMsg (..)
+      MagnifyMsg (..),
+      Magnifier,
     ) where
 
 import XMonad
 import XMonad.StackSet
 import XMonad.Layout.LayoutModifier
+import XMonad.Util.XUtils
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -159,6 +161,3 @@ fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'
           y' = max sy (y - (max 0 (y + fi h - sy - fi sh)))
           w' = min sw w
           h' = min sh h
-
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral

XMonad/Layout/Master.hs

@@ -17,7 +17,9 @@ module XMonad.Layout.Master (
     -- * Usage
     -- $usage
 
-    mastered
+    mastered,
+    multimastered,
+    AddMaster,
 ) where
 
 import XMonad
@@ -34,6 +36,10 @@ import XMonad.Layout.LayoutModifier
 --
 -- > mastered (1/100) (1/2) $ Grid
 --
+-- Or if you want multiple (here two) master windows from the beginning:
+--
+-- > multimastered 2 (1/100) (1/2) $ Grid
+--
 -- This will use the left half of your screen for a master window and let
 -- Grid manage the right half.
 --
@@ -45,42 +51,68 @@ import XMonad.Layout.LayoutModifier
 
 -- | Data type for LayoutModifier which converts given layout to a mastered
 -- layout
-data AddMaster a = AddMaster Rational Rational deriving (Show, Read)
+data AddMaster a = AddMaster Int Rational Rational deriving (Show, Read)
 
 -- | Modifier which converts given layout to a mastered one
+multimastered :: (LayoutClass l a) =>
+       Int -- ^ @k@, number of master windows
+    -> Rational -- ^ @delta@, the ratio of the screen to resize by
+    -> Rational -- ^ @frac@, what portion of the screen to use for the master window
+    -> l a      -- ^ the layout to be modified
+    -> ModifiedLayout AddMaster l a
+multimastered k delta frac = ModifiedLayout $ AddMaster k delta frac
+
 mastered :: (LayoutClass l a) =>
        Rational -- ^ @delta@, the ratio of the screen to resize by
     -> Rational -- ^ @frac@, what portion of the screen to use for the master window
     -> l a      -- ^ the layout to be modified
     -> ModifiedLayout AddMaster l a
-mastered delta frac = ModifiedLayout $ AddMaster delta frac
+mastered delta frac = multimastered 1 delta frac
 
 instance LayoutModifier AddMaster Window where
-    modifyLayout (AddMaster delta frac) = applyMaster delta frac
+    modifyLayout (AddMaster k delta frac) = applyMaster k delta frac
     modifierDescription _               = "Mastered"
 
-    pureMess (AddMaster delta frac) m
-        | Just Shrink <- fromMessage m = Just $ AddMaster delta (frac-delta)
-        | Just Expand <- fromMessage m = Just $ AddMaster delta (frac+delta)
+    pureMess (AddMaster k delta frac) m
+        | Just Shrink <- fromMessage m = Just $ AddMaster k delta (frac-delta)
+        | Just Expand <- fromMessage m = Just $ AddMaster k delta (frac+delta)
+        | Just (IncMasterN d) <- fromMessage m = Just $ AddMaster (max 1 (k+d)) delta frac
 
     pureMess _ _ = Nothing
 
 -- | Internal function for adding a master window and let the modified
 -- layout handle the rest of the windows
 applyMaster :: (LayoutClass l Window) =>
-                  Rational
+                  Int
+               -> Rational
                -> Rational
                -> S.Workspace WorkspaceId (l Window) Window
                -> Rectangle
                -> X ([(Window, Rectangle)], Maybe (l Window))
-applyMaster _ frac wksp rect = do
+applyMaster k _ frac wksp rect = do
     let st= S.stack wksp
     let ws = S.integrate' $ st
-    if length ws > 1 then do
-        let m = head ws
-        let (mr, sr) = splitHorizontallyBy frac rect
-        let nst = st>>= S.filter (m/=)
-        wrs <- runLayout (wksp {S.stack = nst}) sr
-        return ((m, mr) : fst wrs, snd wrs)
-
+    let n = length ws
+    if n > 1 then do
+        if(n<=k) then
+             return ((divideCol rect ws), Nothing)
+             else do
+             let m = take k ws
+             let (mr, sr) = splitHorizontallyBy frac rect
+             let nst = st>>= S.filter (\w -> not (w `elem` m))
+             wrs <- runLayout (wksp {S.stack = nst}) sr
+             return ((divideCol mr m) ++ (fst wrs), snd wrs)
         else runLayout wksp rect
+
+-- | Shift rectangle down
+shiftD :: Position -> Rectangle -> Rectangle
+shiftD s (Rectangle x y w h) = Rectangle x (y+s) w h
+
+-- | Divide rectangle between windows
+divideCol :: Rectangle -> [a] -> [(a, Rectangle)]
+divideCol (Rectangle x y w h) ws = zip ws rects
+    where n = length ws
+          oneH = fromIntegral h `div` n
+          oneRect = Rectangle x y w (fromIntegral oneH)
+          rects = take n $ iterate (shiftD (fromIntegral oneH)) oneRect
+

XMonad/Layout/Maximize.hs

@@ -19,7 +19,8 @@ module XMonad.Layout.Maximize (
         -- * Usage
         -- $usage
         maximize,
-        maximizeRestore
+        maximizeRestore,
+        Maximize, MaximizeRestore,
     ) where
 
 import XMonad
@@ -64,12 +65,14 @@ instance LayoutModifier Maximize Window where
     pureModifier (Maximize (Just target)) rect (Just (S.Stack focused _ _)) wrs =
             if focused == target
                 then (maxed ++ rest, Nothing)
-                else (rest ++ maxed, Nothing)
+                else (rest ++ maxed, lay)
         where
             (toMax, rest) = partition (\(w, _) -> w == target) wrs
             maxed = map (\(w, _) -> (w, maxRect)) toMax
             maxRect = Rectangle (rect_x rect + 25) (rect_y rect + 25)
                 (rect_width rect - 50) (rect_height rect - 50)
+            lay | null maxed = Just (Maximize Nothing)
+                | otherwise  = Nothing
     pureModifier _ _ _ wrs = (wrs, Nothing)
 
     pureMess (Maximize mw) m = case fromMessage m of

XMonad/Layout/MessageControl.hs

@@ -6,7 +6,7 @@
 -- Copyright   :  (c) 2008 Quentin Moser
 -- License     :  BSD3
 --
--- Maintainer  :  <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -41,7 +41,7 @@ import Control.Arrow (second)
 -- > import XMonad.Layout.MessageEscape
 --
 -- Then, if you use a modified layout where the modifier would intercept
--- a message, but you'd want to be able to send it to the inner layout 
+-- a message, but you'd want to be able to send it to the inner layout
 -- only, add the 'unEscape' modifier to the inner layout like so:
 --
 -- > import XMonad.Layout.Master (mastered)
@@ -60,7 +60,7 @@ import Control.Arrow (second)
 -- layout, use the 'ignore' modifier:
 --
 -- > myLayout = Tall ||| (ignore NextLayout $ ignore (JumpToLayout "") $
--- >                       unEscape $ mastered 0.01 0.5 
+-- >                       unEscape $ mastered 0.01 0.5
 -- >                         $ Full ||| simpleTabbed)
 --
 -- /IMPORTANT NOTE:/ The standard '(|||)' operator from "XMonad.Layout"
@@ -121,6 +121,6 @@ unEscape l = ModifiedLayout UE l
 -- | Applies the Ignore layout modifier to a layout, blocking
 -- all messages of the same type as the one passed as its first argument.
 
-ignore :: (Message m, LayoutClass l w) 
+ignore :: (Message m, LayoutClass l w)
           => m -> l w -> (Ignore m l w)
 ignore _ l = I l

XMonad/Layout/Minimize.hs

@@ -1,8 +1,8 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Minimize
--- Copyright   :  (c) Jan Vornberger 2009
+-- Copyright   :  (c) Jan Vornberger 2009, Alejandro Serrano 2010
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
@@ -18,14 +18,20 @@ module XMonad.Layout.Minimize (
         -- * Usage
         -- $usage
         minimize,
-        MinimizeMsg(..)
+        minimizeWindow,
+        MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin),
+        Minimize,
     ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Layout.LayoutModifier
 import XMonad.Layout.BoringWindows as BW
+import XMonad.Util.WindowProperties (getProp32)
 import Data.List
+import qualified Data.Map as M
+import Data.Maybe
+import Foreign.C.Types (CLong)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -43,7 +49,7 @@ import Data.List
 --
 -- In the key-bindings, do something like:
 --
--- >        , ((modm,               xK_m     ), withFocused (\f -> sendMessage (MinimizeWin f)))
+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow)
 -- >        , ((modm .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
 --
 -- The first action will minimize the focused window, while the second one will restore
@@ -54,15 +60,16 @@ import Data.List
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 --
 -- The module is designed to work together with "XMonad.Layout.BoringWindows" so
--- that minimized windows will be skipped when switching the focus window with
--- the keyboard.  Use the 'BW.boringAuto' function.
+-- that minimized windows will be skipped over when switching the focused window with
+-- the keyboard. Include 'BW.boringWindows' in your layout hook and see the
+-- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings.
 --
--- Also see "XMonad.Hooks.RestoreMinimized" if you want to be able to restore
--- minimized windows from your taskbar.
+-- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize
+-- and restore windows from your taskbar.
 
-data Minimize a = Minimize [Window] deriving ( Read, Show )
+data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show )
 minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window
-minimize = ModifiedLayout $ Minimize []
+minimize = ModifiedLayout $ Minimize [] M.empty
 
 data MinimizeMsg = MinimizeWin Window
                     | RestoreMinimizedWin Window
@@ -70,25 +77,68 @@ data MinimizeMsg = MinimizeWin Window
                     deriving (Typeable, Eq)
 instance Message MinimizeMsg
 
-instance LayoutModifier Minimize Window where
-    modifierDescription (Minimize _) = "Minimize"
+minimizeWindow :: Window -> X ()
+minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown
 
-    modifyLayout (Minimize minimized) wksp rect = do
+setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
+setMinimizedState win st f = do
+    setWMState win st
+    withDisplay $ \dpy -> do
+        state <- getAtom "_NET_WM_STATE"
+        mini <- getAtom "_NET_WM_STATE_HIDDEN"
+        wstate <- fromMaybe [] `fmap` getProp32 state win
+        let ptype = 4 -- The atom property type for changeProperty
+            fi_mini = fromIntegral mini
+        io $ changeProperty32 dpy win state ptype propModeReplace (f fi_mini wstate)
+
+setMinimized :: Window -> X ()
+setMinimized win = setMinimizedState win iconicState (:)
+
+setNotMinimized :: Window -> X ()
+setNotMinimized win = setMinimizedState win normalState delete
+
+instance LayoutModifier Minimize Window where
+    modifierDescription _ = "Minimize"
+
+    modifyLayout (Minimize minimized _) wksp rect = do
         let stack = W.stack wksp
             filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))
         runLayout (wksp {W.stack = filtStack}) rect
 
-    handleMess (Minimize minimized) m = case fromMessage m of
-        Just (MinimizeWin w)
-          | not (w `elem` minimized) -> do
-                BW.focusDown
-                return $ Just $ Minimize (w:minimized)
-          | otherwise               -> return Nothing
-        Just (RestoreMinimizedWin w) ->
-            return $ Just $ Minimize (minimized \\ [w])
-        Just (RestoreNextMinimizedWin)
-          | not (null minimized)    -> do
-                focus (head minimized)
-                return $ Just $ Minimize (tail minimized)
-          | otherwise               -> return Nothing
-        _ -> return Nothing
+    handleMess (Minimize minimized unfloated) m
+        | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do
+                setMinimized w
+                ws <- gets windowset
+                case M.lookup w (W.floating ws) of
+                  Nothing -> return $ Just $ Minimize (w:minimized) unfloated
+                  Just r -> do
+                    modify (\s -> s { windowset = W.sink w ws})
+                    return $ Just $ Minimize (w:minimized) (M.insert w r unfloated)
+        | Just (RestoreMinimizedWin w) <- fromMessage m = do
+            setNotMinimized w
+            case M.lookup w unfloated of
+              Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated
+              Just r -> do
+                ws <- gets windowset
+                modify (\s -> s { windowset = W.float w r ws})
+                return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)
+        | Just RestoreNextMinimizedWin <- fromMessage m = do
+          ws <- gets windowset
+          if not (null minimized)
+            then case M.lookup (head minimized) unfloated of
+              Nothing -> do
+                let w = head minimized
+                setNotMinimized w
+                modify (\s -> s { windowset = W.focusWindow w ws})
+                return $ Just $ Minimize (tail minimized) unfloated
+              Just r -> do
+                let w = head minimized
+                setNotMinimized w
+                modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws})
+                return $ Just $ Minimize (tail minimized) (M.delete w unfloated)
+            else return Nothing
+        | Just BW.UpdateBoring <- fromMessage m = do
+            ws <- gets (W.workspace . W.current . windowset)
+            flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized
+            return Nothing
+        | otherwise = return Nothing

XMonad/Layout/Mosaic.hs

@@ -21,6 +21,8 @@ module XMonad.Layout.Mosaic (
     ,mosaic
     ,changeMaster
     ,changeFocused
+
+    ,Mosaic
     )
     where
 

XMonad/Layout/MosaicAlt.hs

@@ -25,6 +25,9 @@ module XMonad.Layout.MosaicAlt (
         , tallWindowAlt
         , wideWindowAlt
         , resetAlt
+
+        , Params, Param
+        , HandleWindowAlt
     ) where
 
 import XMonad