packages feed

xmonad-contrib (empty) → 0.5

raw patch · 101 files changed

+11725/−0 lines, 101 filesdep +X11dep +X11-xftdep +basebuild-type:Customsetup-changed

Dependencies added: X11, X11-xft, base, containers, directory, mtl, process, random, unix, xmonad

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) The Xmonad Community++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ README view
@@ -0,0 +1,28 @@+3rd party xmonad extensions and contributions.++Build and install through Cabal as for other Haskell packages:++        runhaskell Setup configure --user --prefix=$HOME+        runhaskell Setup build+        runhaskell Setup install --user++(You may want to remove the --user flag when installing as root.)++scripts/ contains further external programs useful with xmonad.++Haskell code contributed to this repo should live under the+appropriate subdivision of the 'XMonad.' namespace (currently includes+Actions, Config, Hooks, Layout, Prompt, and Util). For example, to use+the Mosaic layout, one would import:++ XMonad.Layout.Mosaic++------------------------------------------------------------------------++Code submitted to the contrib repo is licensed under the same license as+xmonad itself, with copyright held by the authors.++------------------------------------------------------------------------++Documentation for the extensions and configuration system is available+in Haddock form in the XMonad.Doc module and submodules.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ XMonad/Actions/Commands.hs view
@@ -0,0 +1,120 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Commands+-- Copyright   :  (c) David Glasser 2007+-- License     :  BSD3+--+-- Maintainer  :  glasser@mit.edu+-- Stability   :  stable+-- Portability :  portable+--+-- Allows you to run internal xmonad commands (X () actions) using+-- a dmenu menu in addition to key bindings.  Requires dmenu and+-- the Dmenu XMonad.Actions module.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Commands (+                             -- * Usage+                             -- $usage+                             commandMap,+                             runCommand,+                             runCommand',+                             workspaceCommands,+                             screenCommands,+                             defaultCommands+                              ) where++import XMonad+import XMonad.StackSet hiding (workspaces)+import XMonad.Util.Dmenu (dmenu)++import qualified Data.Map as M+import System.Exit+import Data.Maybe++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.Commands+--+-- Then add a keybinding to the runCommand action:+--+-- >    , ((modMask x .|. controlMask, xK_y), runCommand commands)+--+-- and define the list of commands you want to use:+--+-- >    commands :: [(String, X ())]+-- >    commands = defaultCommands+--+-- Whatever key you bound to will now cause a popup menu of internal+-- xmonad commands to appear.  You can change the commands by+-- changing the contents of the list 'commands'.  (If you like it+-- enough, you may even want to get rid of many of your other key+-- bindings!)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a+--   list of pairs.+commandMap :: [(String, X ())] -> M.Map String (X ())+commandMap c = M.fromList c++-- | Generate a list of commands to switch to\/send windows to workspaces.+workspaceCommands :: X [(String, X ())]+workspaceCommands = asks (workspaces . config) >>= \spaces -> return+                            [((m ++ show i), windows $ f i)+                                | i <- spaces+                                , (f, m) <- [(view, "view"), (shift, "shift")] ]++-- | Generate a list of commands dealing with multiple screens.+screenCommands :: [(String, X ())]+screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))+                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes+                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]+                 ]++-- | A nice pre-defined list of commands.+defaultCommands :: X [(String, X ())]+defaultCommands = do+    wscmds <- workspaceCommands+    return $ wscmds ++ screenCommands ++ otherCommands+ where+    sr = broadcastMessage ReleaseResources+    otherCommands =+        [ ("shrink"              , sendMessage Shrink                               )+        , ("expand"              , sendMessage Expand                               )+        , ("next-layout"         , sendMessage NextLayout                           )+        , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )+        , ("restart-wm"          , sr >> restart Nothing True                       )+        , ("restart-wm-no-resume", sr >> restart Nothing False                      )+        , ("xterm"               , spawn =<< asks (terminal .  config)              )+        , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )+        , ("kill"                , kill                                             )+        , ("refresh"             , refresh                                          )+        , ("focus-up"            , windows $ focusUp                                )+        , ("focus-down"          , windows $ focusDown                              )+        , ("swap-up"             , windows $ swapUp                                 )+        , ("swap-down"           , windows $ swapDown                               )+        , ("swap-master"         , windows $ swapMaster                             )+        , ("sink"                , withFocused $ windows . sink                     )+        , ("quit-wm"             , io $ exitWith ExitSuccess                        )+        ]++-- | Given a list of command\/action pairs, prompt the user to choose a+--   command and return the corresponding action.+runCommand :: [(String, X ())] -> X ()+runCommand cl = do+  let m = commandMap cl+  choice <- dmenu (M.keys m)+  fromMaybe (return ()) (M.lookup choice m)++-- | Given the name of a command from 'defaultCommands', return the+--   corresponding action (or the null action if the command is not+--   found).+runCommand' :: String -> X ()+runCommand' c = do+  m <- fmap commandMap defaultCommands+  fromMaybe (return ()) (M.lookup c m)
+ XMonad/Actions/ConstrainedResize.hs view
@@ -0,0 +1,57 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.ConstrainedResize+-- Copyright   :  (c) Dougal Stanton+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <dougal@dougalstanton.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Lets you constrain the aspect ratio of a floating+-- window (by, say, holding shift while you resize).+--+-- Useful for making a nice circular XClock window.+--+-----------------------------------------------------------------------------++module XMonad.Actions.ConstrainedResize (+	-- * Usage+	-- $usage+	XMonad.Actions.ConstrainedResize.mouseResizeWindow+) where++import XMonad++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import qualified XMonad.Actions.ConstrainedResize as Sqr+--+-- Then add something like the following to your mouse bindings:+--+-- >     , ((modMask x, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))+-- >     , ((modMask x .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))+--+-- The line without the shiftMask replaces the standard mouse resize+-- function call, so it's not completely necessary but seems neater+-- this way.+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++-- | Resize (floating) window with optional aspect ratio constraints.+mouseResizeWindow :: Window -> Bool -> X ()+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    wa <- io $ getWindowAttributes d w+    sh <- io $ getWMNormalHints d w+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))+    mouseDrag (\ex ey -> do+                 let x = ex - fromIntegral (wa_x wa)+                     y = ey - fromIntegral (wa_y wa)+                     sz = if c then (max x y, max x y) else (x,y)+                 io $ resizeWindow d w `uncurry`+                    applySizeHints sh sz)+              (float w)
+ XMonad/Actions/CopyWindow.hs view
@@ -0,0 +1,85 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CopyWindow+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides a binding to duplicate a window on multiple workspaces,+-- providing dwm-like tagging functionality.+--+-----------------------------------------------------------------------------++module XMonad.Actions.CopyWindow (+                                 -- * Usage+                                 -- $usage+                                 copy, copyWindow, kill1+                                ) where++import Prelude hiding ( filter )+import qualified Data.List as L+import XMonad hiding (modify)+import XMonad.StackSet++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.CopyWindow+--+-- Then add something like this to your keybindings:+--+-- > -- mod-[1..9] @@ Switch to workspace N+-- > -- mod-shift-[1..9] @@ Move client to workspace N+-- > -- mod-control-shift-[1..9] @@ Copy client to workspace N+-- > [((m .|. modMask x, k), windows $ f i)+-- >     | (i, k) <- zip (workspaces x) [xK_1 ..]+-- >     , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]]+--+-- To use the above key bindings you need also to import+-- "XMonad.StackSet":+--+-- > import qualified XMonad.StackSet as W+--+-- You may also wish to redefine the binding to kill a window so it only+-- removes it from the current workspace, if it's present elsewhere:+--+-- >  , ((modMask x .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | copy. Copy the focussed window to a new workspace.+copy :: WorkspaceId -> WindowSet -> WindowSet+copy n s | Just w <- peek s = copyWindow w n s+         | otherwise = s++-- | copyWindow.  Copy a window to a new workspace+copyWindow :: Window -> WorkspaceId -> WindowSet -> WindowSet+copyWindow w n = copy'+    where copy' s = if n `tagMember` s+                    then view (tag (workspace (current s))) $ insertUp' w $ view n s+                    else s+          insertUp' a s = modify (Just $ Stack a [] [])+                          (\(Stack t l r) -> if a `elem` t:l++r+                                             then Just $ Stack t l r+                                             else Just $ Stack a (L.delete a l) (L.delete a (t:r))) s+++-- | Remove the focused window from this workspace.  If it's present in no+-- other workspace, then kill it instead. If we do kill it, we'll get a+-- delete notify back from X.+--+-- There are two ways to delete a window. Either just kill it, or if it+-- supports the delete protocol, send a delete event (e.g. firefox)+--+kill1 :: X ()+kill1 = do ss <- gets windowset+           whenJust (peek ss) $ \w -> if member w $ delete'' w ss+                                      then windows $ delete'' w+                                      else kill+    where delete'' w = modify Nothing (filter (/= w))
+ XMonad/Actions/CycleWS.hs view
@@ -0,0 +1,94 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CycleWS+-- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>,+--                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides bindings to cycle forward or backward through the list+-- of workspaces, and to move windows there.+--+-----------------------------------------------------------------------------++module XMonad.Actions.CycleWS (+                              -- * Usage+                              -- $usage+                              nextWS,+                              prevWS,+                              shiftToNext,+                              shiftToPrev,+                              toggleWS,+                             ) where++import Data.List ( sortBy, findIndex )+import Data.Maybe ( fromMaybe )+import Data.Ord ( comparing )++import XMonad hiding (workspaces)+import qualified XMonad (workspaces)+import XMonad.StackSet hiding (filter)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.CycleWS+--+-- >   , ((modMask x,               xK_Right), nextWS)+-- >   , ((modMask x,               xK_Left),  prevWS)+-- >   , ((modMask x .|. shiftMask, xK_Right), shiftToNext)+-- >   , ((modMask x .|. shiftMask, xK_Left),  shiftToPrev)+-- >   , ((modMask x,               xK_t),     toggleWS)+--+-- If you want to follow the moved window, you can use both actions:+--+-- >   , ((modMask x .|. shiftMask, xK_Right), shiftToNext >> nextWS)+-- >   , ((modMask x .|. shiftMask, xK_Left),  shiftToPrev >> prevWS)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++-- | Switch to next workspace+nextWS :: X ()+nextWS = switchWorkspace 1++-- | Switch to previous workspace+prevWS :: X ()+prevWS = switchWorkspace (-1)++-- | Move focused window to next workspace+shiftToNext :: X ()+shiftToNext = shiftBy 1++-- | Move focused window to previous workspace+shiftToPrev :: X ()+shiftToPrev = shiftBy (-1)++-- | Toggle to the workspace displayed previously+toggleWS :: X ()+toggleWS = windows $ view =<< tag . head . hidden++switchWorkspace :: Int -> X ()+switchWorkspace d = wsBy d >>= windows . greedyView++shiftBy :: Int -> X ()+shiftBy d = wsBy d >>= windows . shift++wsBy :: Int -> X (WorkspaceId)+wsBy d = do+    ws <- gets windowset+    spaces <- asks (XMonad.workspaces . config)+    let orderedWs = sortBy (comparing (wsIndex spaces)) (workspaces ws)+    let now = fromMaybe 0 $ findWsIndex (workspace (current ws)) orderedWs+    let next = orderedWs !! ((now + d) `mod` length orderedWs)+    return $ tag next++wsIndex :: [WorkspaceId] -> WindowSpace -> Maybe Int+wsIndex spaces ws = findIndex (== tag ws) spaces++findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int+findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
+ XMonad/Actions/DeManage.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DeManage+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module provides a method to cease management of a window+-- without unmapping it.  This is especially useful for applications+-- like kicker and gnome-panel.+--+-- To make a panel display correctly with xmonad:+--+--  * Determine the pixel size of the panel, add that value to+--    'XMonad.Core.XConfig.defaultGaps'+--+--  * Launch the panel+--+--  * Give the panel window focus, then press @mod-d@ (or whatever key+--    you have bound 'demanage' to)+--+--  * Convince the panel to move\/resize to the correct location.  Changing the+--  panel's position setting several times seems to work.+--+-----------------------------------------------------------------------------++module XMonad.Actions.DeManage (+                                 -- * Usage+                                 -- $usage+                                 demanage+                                ) where++import qualified XMonad.StackSet as W+import XMonad++-- $usage+-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:+--+-- >     import XMonad.Actions.DeManage+--+-- And add a keybinding, such as:+--+-- > , ((modMask x,               xK_d     ), withFocused demanage)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Stop managing the currently focused window.+demanage :: Window -> X ()+demanage w = do+    -- use modify to defeat automatic 'unmanage' calls.+    modify (\s -> s { windowset = W.delete w (windowset s) })+    refresh
+ XMonad/Actions/DwmPromote.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DwmPromote+-- Copyright   :  (c) Miikka Koskinen 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  arcatan@kapsi.fi+-- Stability   :  unstable+-- Portability :  unportable+--+-- Dwm-like swap function for xmonad.+--+-- Swaps focused window with the master window. If focus is in the+-- master, swap it with the next window in the stack. Focus stays in the+-- master.+--+-----------------------------------------------------------------------------++module XMonad.Actions.DwmPromote (+                                 -- * Usage+                                 -- $usage+                                 dwmpromote+                                ) where++import XMonad+import XMonad.StackSet++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.DwmPromote+--+-- then add a keybinding or substitute 'dwmpromote' in place of promote:+--+-- >   , ((modMask x,               xK_Return), dwmpromote)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Swap the focused window with the master window. If focus is in+--   the master, swap it with the next window in the stack. Focus+--   stays in the master.+dwmpromote :: X ()+dwmpromote = windows $ modify' $+             \c -> case c of+                   Stack _ [] []     -> c+                   Stack t [] (x:rs) -> Stack x [] (t:rs)+                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls
+ XMonad/Actions/DynamicWorkspaces.hs view
@@ -0,0 +1,127 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DynamicWorkspaces+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides bindings to add and delete workspaces.  Note that you may only+-- delete a workspace that is already empty.+--+-----------------------------------------------------------------------------++module XMonad.Actions.DynamicWorkspaces (+                                         -- * Usage+                                         -- $usage+                                         addWorkspace, removeWorkspace,+                                         withWorkspace,+                                         selectWorkspace, renameWorkspace,+                                         toNthWorkspace, withNthWorkspace+                                       ) where++import Data.List ( sort )++import XMonad hiding (workspaces)+import XMonad.StackSet hiding (filter, modify, delete)+import XMonad.Prompt.Workspace+import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.DynamicWorkspaces+--+-- Then add keybindings like the following:+--+-- >   , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)+-- >   , ((modMask x .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)+-- >   , ((modMask x, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))+-- >   , ((modMask x .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))+-- >   , ((modMask x .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)+--+-- > -- mod-[1..9]       %! Switch to workspace N+-- > -- mod-shift-[1..9] %! Move client to workspace N+-- >    +++-- >    zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])+-- >    +++-- >    zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++data Wor = Wor String++instance XPrompt Wor where+    showXPrompt (Wor x) = x++mkCompl :: [String] -> String -> IO [String]+mkCompl l s = return $ filter (\x -> take (length s) x == s) l++withWorkspace :: XPConfig -> (String -> X ()) -> X ()+withWorkspace c job = do ws <- gets (workspaces . windowset)+                         let ts = sort $ map tag ws+                             job' t | t `elem` ts = job t+                                    | otherwise = addHiddenWorkspace t >> job t+                         mkXPrompt (Wor "") c (mkCompl ts) job'++renameWorkspace :: XPConfig -> X ()+renameWorkspace conf = workspacePrompt conf $ \w ->+                       windows $ \s -> let sett wk = wk { tag = w }+                                           setscr scr = scr { workspace = sett $ workspace scr }+                                           sets q = q { current = setscr $ current q }+                                       in sets $ removeWorkspace' w s++toNthWorkspace :: (String -> X ()) -> Int -> X ()+toNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)+                             case drop wnum ws of+                               (w:_) -> job w+                               [] -> return ()++withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()+withNthWorkspace job wnum = do ws <- gets (sort . map tag . workspaces . windowset)+                               case drop wnum ws of+                                 (w:_) -> windows $ job w+                                 [] -> return ()++selectWorkspace :: XPConfig -> X ()+selectWorkspace conf = workspacePrompt conf $ \w ->+                       do s <- gets windowset+                          if tagMember w s+                            then windows $ greedyView w+                            else addWorkspace w++-- | Add a new workspace with the given name.+addWorkspace :: String -> X ()+addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)++addHiddenWorkspace :: String -> X ()+addHiddenWorkspace newtag = do l <- asks (layoutHook . config)+                               windows (addHiddenWorkspace' newtag l)++-- | Remove the current workspace if it contains no windows.+removeWorkspace :: X ()+removeWorkspace = do s <- gets windowset+                     case s of+                       StackSet { current = Screen { workspace = torem }+                                , hidden = (w:_) }+                           -> do windows $ view (tag w)+                                 windows (removeWorkspace' (tag torem))+                       _ -> return ()++addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd+addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }++removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd+removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })+                                   , hidden = (w:ws) })+    | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }+                         , hidden = ws }+   where meld Nothing Nothing = Nothing+         meld x Nothing = x+         meld Nothing x = x+         meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)+removeWorkspace' _ s = s
+ XMonad/Actions/FindEmptyWorkspace.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.FindEmptyWorkspace+-- Copyright   :  (c) Miikka Koskinen 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  arcatan@kapsi.fi+-- Stability   :  unstable+-- Portability :  unportable+--+-- Find an empty workspace.+--+-----------------------------------------------------------------------------++module XMonad.Actions.FindEmptyWorkspace (+    -- * Usage+    -- $usage+    viewEmptyWorkspace, tagToEmptyWorkspace+  ) where++import Data.List+import Data.Maybe ( isNothing )++import XMonad+import XMonad.StackSet++-- $usage+--+-- To use, import this module into your @~\/.xmonad\/xmonad.hs@:+--+-- >   import XMonad.Actions.FindEmptyWorkspace+--+-- and add the desired keybindings, for example:+--+--  >   , ((modMask x,                xK_m    ), viewEmptyWorkspace)+--  >   , ((modMask x .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)+--+-- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@+-- will tag the current window to an empty workspace and view it.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Find the first hidden empty workspace in a StackSet. Returns+-- Nothing if all workspaces are in use. Function searches currently+-- focused workspace, other visible workspaces (when in Xinerama) and+-- hidden workspaces in this order.+findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a)+findEmptyWorkspace = find (isNothing . stack) . allWorkspaces+  where+    allWorkspaces ss = (workspace . current) ss :+                       (map workspace . visible) ss ++ hidden ss++withEmptyWorkspace :: (WorkspaceId -> X ()) -> X ()+withEmptyWorkspace f = do+    ws <- gets windowset+    whenJust (findEmptyWorkspace ws) (f . tag)++-- | Find and view an empty workspace. Do nothing if all workspaces are+-- in use.+viewEmptyWorkspace :: X ()+viewEmptyWorkspace = withEmptyWorkspace (windows . view)++-- | Tag current window to an empty workspace and view it. Do nothing if+-- all workspaces are in use.+tagToEmptyWorkspace :: X ()+tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w
+ XMonad/Actions/FlexibleManipulate.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.FlexibleManipulate+-- Copyright   :  (c) Michael Sloan+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <mgsloan@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Move and resize floating windows without warping the mouse.+--+-----------------------------------------------------------------------------++-- Based on the FlexibleResize code by Lukas Mai (mauke).++module XMonad.Actions.FlexibleManipulate (+	-- * Usage+	-- $usage+	mouseWindow, discrete, linear, resize, position+) where++import XMonad++-- $usage+-- First, add this import to your @~\/.xmonad\/xmonad.hs@:+--+-- > import qualified XMonad.Actions.FlexibleManipulate as Flex+--+-- Now set up the desired mouse binding, for example:+--+-- >     , ((modMask x, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))+--+-- * Flex.'linear' indicates that positions between the edges and the+--   middle indicate a combination scale\/position.+--+-- * Flex.'discrete' indicates that there are discrete pick+--   regions. (The window is divided by thirds for each axis.)+--+-- * Flex.'resize' performs only a resize of the window, based on which+--   quadrant the mouse is in.+--+-- * Flex.'position' is similar to the built-in+--   'XMonad.Operations.mouseMoveWindow'.+--+-- You can also write your own function for this parameter. It should take+-- a value between 0 and 1 indicating position, and return a value indicating+-- the corresponding position if plain Flex.'linear' was used.+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++discrete, linear, resize, position :: Double -> Double++-- | Manipulate the window based on discrete pick regions; the window+--   is divided into regions by thirds along each axis.+discrete x | x < 0.33 = 0+           | x > 0.66 = 1+           | otherwise = 0.5++-- | Scale\/reposition the window by factors obtained from the mouse+--   position by linear interpolation. Dragging precisely on a corner+--   resizes that corner; dragging precisely in the middle moves the+--   window without resizing; anything else is an interpolation+--   between the two.+linear = id++-- | Only resize the window, based on the window quadrant the mouse is in.+resize x = if x < 0.5 then 0 else 1++-- | Only reposition the window.+position = const 0.5++-- | Given an interpolation function, implement an appropriate window+--   manipulation action.+mouseWindow :: (Double -> Double) -> Window -> X ()+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs+    sh <- io $ getWMNormalHints d w+    pointer <- io $ queryPointer d w >>= return . pointerPos++    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+        atl = ((1, 1) - fc) * mul+        abr = fc * mul+    mouseDrag (\ex ey -> io $ do+        let offset = (fromIntegral ex, fromIntegral ey) - pointer+            npos = wpos + offset * atl+            nbr = (wpos + wsize) + offset * abr+            ntl = minP (nbr - (32, 32)) npos    --minimum size+            nwidth = applySizeHints sh $ mapP (round :: Double -> Integer) (nbr - ntl)+        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth+        return ())+        (float w)++    float w++  where+    pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt+    winAttrs :: WindowAttributes -> [Pnt]+    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]+++-- I'd rather I didn't have to do this, but I hate writing component 2d math+type Pnt = (Double, Double)++pairUp :: [a] -> [(a,a)]+pairUp [] = []+pairUp [_] = []+pairUp (x:y:xs) = (x, y) : (pairUp xs)++mapP :: (a -> b) -> (a, a) -> (b, b)+mapP f (x, y) = (f x, f y)+zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)+zipP 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++instance Fractional Pnt where+    fromRational = const undefined+    recip = mapP recip
+ XMonad/Actions/FlexibleResize.hs view
@@ -0,0 +1,67 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.FlexibleResize+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Resize floating windows from any corner.+--+-----------------------------------------------------------------------------++module XMonad.Actions.FlexibleResize (+	-- * Usage+	-- $usage+	XMonad.Actions.FlexibleResize.mouseResizeWindow+) where++import XMonad+import Foreign.C.Types++-- $usage+-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import qualified XMonad.Actions.FlexibleResize as Flex+--+-- Then add an appropriate mouse binding:+--+-- >     , ((modMask x, button3), (\w -> focus w >> Flex.mouseResizeWindow w))+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++-- | Resize a floating window from whichever corner the mouse is+--   closest to.+mouseResizeWindow :: Window -> X ()+mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    wa <- io $ getWindowAttributes d w+    sh <- io $ getWMNormalHints d w+    (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w+    let+        [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height]+        west  = firstHalf ix width+        north = firstHalf iy height+        (cx, fx, gx) = mkSel west  width  pos_x+        (cy, fy, gy) = mkSel north height pos_y+    io $ warpPointer d none w 0 0 0 0 cx cy+    mouseDrag (\ex ey -> do+                 wa' <- io $ getWindowAttributes d w+                 let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y]+                 io $ moveResizeWindow d w (fx px (fromIntegral ex))+                                           (fy py (fromIntegral ey))+                            `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey))+              (float w)+    where+    firstHalf :: CInt -> Position -> Bool+    firstHalf a b = fromIntegral a * 2 <= b+    cfst = curry fst+    csnd = curry snd+    mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Position)+    mkSel b k p =+        if b+            then (0, csnd, ((k + p) -) . fromIntegral)+            else (k, cfst, subtract p  . fromIntegral)
+ XMonad/Actions/FloatKeys.hs view
@@ -0,0 +1,121 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.FloatKeys+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>+-- License      : BSD+--+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- Move and resize floating windows.+-----------------------------------------------------------------------------++module XMonad.Actions.FloatKeys (+                -- * Usage+                -- $usage+                keysMoveWindow,+                keysMoveWindowTo,+                keysResizeWindow,+                keysAbsResizeWindow) where++import XMonad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.FloatKeys+--+-- Then add appropriate key bindings, for example:+--+-- >  , ((modMask x,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))+-- >  , ((modMask x,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))+-- >  , ((modMask x .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))+-- >  , ((modMask x .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))+-- >  , ((modMask x,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the+--   right and @dy@ pixels down.+keysMoveWindow :: D -> Window -> X ()+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    wa <- io $ getWindowAttributes d w+    io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))+                        (fromIntegral (fromIntegral (wa_y wa) + dy))+    float w++-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative+--   point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a+--   position relative to the window border, i.e.  @gx = 0@ is the left+--   border, @gx = 1@ is the right border, @gy = 0@ is the top border, and+--   @gy = 1@ the bottom border.+--+--   For example, on a 1024x768 screen:+--+-- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen+-- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner+keysMoveWindowTo :: P -> G -> Window -> X ()+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    wa <- io $ getWindowAttributes d w+    io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))+                        (y - round (gy * fromIntegral (wa_height wa)))+    float w++type G = (Rational, Rational)+type P = (Position, Position)++-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@+--   and the height by @dy@, leaving the window-relative point @(gx,+--   gy)@ fixed.+--+--   For example:+--+-- > keysResizeWindow (10, 0) (0, 0)      -- make the window 10 pixels larger to the right+-- > keysResizeWindow (10, 0) (0, 1%2)    -- does the same, unless sizeHints are applied+-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side+-- > keysResizeWindow (-10, -10) (0, 1)   -- shrink the window in direction of the bottom-left corner+keysResizeWindow :: D -> G -> Window -> X ()+keysResizeWindow = keysMoveResize keysResizeWindow'++-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@+--   and the height by @dy@, leaving the screen absolute point @(ax,+--   ay)@ fixed.+--+--   For example:+--+-- > keysAbsResizeWindow (10, 10) (0, 0)   -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.+keysAbsResizeWindow :: D -> D -> Window -> X ()+keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'++keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)+keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))+    where+        (nw, nh) = applySizeHints sh (w + dx, h + dy)+        nx :: Rational+        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w+        ny :: Rational+        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h++keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)+keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))+    where+        (nw, nh) = applySizeHints sh (w + dx, h + dy)+        nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw+        ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh++keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do+    io $ raiseWindow d w+    wa <- io $ getWindowAttributes d w+    sh <- io $ getWMNormalHints d w+    let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)+        wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)+        (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize+    io $ resizeWindow d w `uncurry` wn_dim+    io $ moveWindow d w `uncurry` wn_pos+    float w+
+ XMonad/Actions/FocusNth.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.FocusNth+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>+-- License      : BSD+--+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- Focus the nth window of the current workspace.+-----------------------------------------------------------------------------++module XMonad.Actions.FocusNth (+                 -- * Usage+                 -- $usage+                 focusNth) where++import XMonad.StackSet+import XMonad++-- $usage+-- Add the import to your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.FocusNth+--+-- Then add appropriate keybindings, for example:+--+-- > -- mod4-[1..9] @@ Switch to window N+-- > ++ [((modMask x, k), focusNth i)+-- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Give focus to the nth window of the current workspace.+focusNth :: Int -> X ()+focusNth = windows . modify' . focusNth'++focusNth' :: Int -> Stack a -> Stack a+focusNth' n s@(Stack _ ls rs)	| (n < 0) || (n > length(ls) + length(rs)) = s+				| otherwise = listToStack n (integrate s)++listToStack :: Int -> [a] -> Stack a+listToStack n l = Stack t ls rs+	where	(t:rs)	= drop n l+		ls	= reverse (take n l)++
+ XMonad/Actions/MouseGestures.hs view
@@ -0,0 +1,125 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.MouseGestures+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Support for simple mouse gestures.+--+-----------------------------------------------------------------------------++module XMonad.Actions.MouseGestures (+    -- * Usage+    -- $usage+	Direction(..),+    mouseGesture+) where++import XMonad++import Data.IORef+import qualified Data.Map as M+import Data.Map (Map)+import Control.Monad++import System.IO++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.Commands+-- > import qualified XMonad.StackSet as W+--+-- then add an appropriate mouse binding:+--+-- >     , ((modMask x .|. shiftMask, button3), mouseGesture gestures)+--+-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on+-- windows, for example:+--+-- >     gestures = M.fromList+-- >         [ ([], focus)+-- >         , ([U], \w -> focus w >> windows W.swapUp)+-- >         , ([D], \w -> focus w >> windows W.swapDown)+-- >         , ([R, D], \_ -> sendMessage NextLayout)+-- >         ]+--+-- This is just an example, of course; you can use any mouse button and+-- gesture definitions you want.+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++-- | The four cardinal screen directions. A \"gesture\" is a sequence of+--   directions.+data Direction = L | U | R | D+    deriving (Eq, Ord, Show, Read, Enum, Bounded)++type Pos = (Position, Position)++delta :: Pos -> Pos -> Position+delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)+    where+    d a b = abs (a - b)++dir :: Pos -> Pos -> Direction+dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)+    where+    trans :: Double -> Direction+    trans x+        | rg (-3/4) (-1/4) x = D+        | rg (-1/4)  (1/4) x = R+        | rg  (1/4)  (3/4) x = U+        | otherwise          = L+    rg a z x = a <= x && x < z++debugging :: Int+debugging = 0++collect :: IORef (Pos, [(Direction, Pos, Pos)]) -> Position -> Position -> X ()+collect st nx ny = do+    let np = (nx, ny)+    stx@(op, ds) <- io $ readIORef st+    when (debugging > 0) $ io $ putStrLn $ show "Mouse Gesture" ++ unwords (map show (extract stx)) ++ (if debugging > 1 then "; " ++ show op ++ "-" ++ show np else "")+    case ds of+        []+            | insignificant np op -> return ()+            | otherwise -> io $ writeIORef st (op, [(dir op np, np, op)])+        (d, zp, ap_) : ds'+            | insignificant np zp -> return ()+            | otherwise -> do+                let+                    d' = dir zp np+                    ds''+                        | d == d'   = (d, np, ap_) : ds'+                        | otherwise = (d', np, zp) : ds+                io $ writeIORef st (op, ds'')+    where+    insignificant a b = delta a b < 10++extract :: (Pos, [(Direction, Pos, Pos)]) -> [Direction]+extract (_, xs) = reverse . map (\(x, _, _) -> x) $ xs++-- | Given a 'Data.Map.Map' from lists of directions to actions with+--   windows, figure out which one the user is performing, and return+--   the corresponding action.+mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()+mouseGesture tbl win = withDisplay $ \dpy -> do+    root <- asks theRoot+    let win' = if win == none then root else win+    acc <- io $ do+        qp@(_, _, _, ix, iy, _, _, _) <- queryPointer dpy win'+        when (debugging > 1) $ putStrLn $ show "queryPointer" ++ show qp+        when (debugging > 1 && win' == none) $ putStrLn $ show "mouseGesture" ++ "zomg none"+        newIORef ((fromIntegral ix, fromIntegral iy), [])+    mouseDrag (collect acc) $ do+        when (debugging > 0) $ io $ putStrLn $ show ""+        gest <- io $ liftM extract $ readIORef acc+        case M.lookup gest tbl of+            Nothing -> return ()+            Just f -> f win'
+ XMonad/Actions/RotSlaves.hs view
@@ -0,0 +1,62 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.RotSlaves+-- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>+-- License      : BSD3-style (see LICENSE)+--+-- Maintainer   : Hans Philipp Annen <haphi@gmx.net>+-- Stability    : unstable+-- Portability  : unportable+--+-- Rotate all windows except the master window and keep the focus in+-- place.+-----------------------------------------------------------------------------+module XMonad.Actions.RotSlaves (+	-- $usage+	rotSlaves', rotSlavesUp, rotSlavesDown,+	rotAll', rotAllUp, rotAllDown+	) where++import XMonad.StackSet+import XMonad++-- $usage+--+-- To use this module, import it with:+--+-- > import XMonad.Actions.RotSlaves+--+-- and add whatever keybindings you would like, for example:+--+-- > , ((modMask x .|. shiftMask, xK_Tab   ), rotSlavesUp)+--+-- This operation will rotate all windows except the master window,+-- while the focus stays where it is. It is useful together with the+-- TwoPane layout (see "XMonad.Layout.TwoPane").+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Rotate the windows in the current stack, excluding the first one+--   (master).+rotSlavesUp,rotSlavesDown :: X ()+rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))+rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))++-- | The actual rotation, as a pure function on the window stack.+rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a+rotSlaves' _ s@(Stack _ [] []) = s+rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus+rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise+    where  (master:ws)     = integrate s+           (revls',t':rs') = splitAt (length ls) (master:(f ws))++-- | Rotate all the windows in the current stack.+rotAllUp,rotAllDown :: X ()+rotAllUp   = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))+rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))++-- | The actual rotation, as a pure function on the window stack.+rotAll' :: ([a] -> [a]) -> Stack a -> Stack a+rotAll' f s = Stack r (reverse revls) rs+    where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))
+ XMonad/Actions/RotView.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.RotView+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides bindings to cycle through non-empty workspaces.+--+-----------------------------------------------------------------------------++module XMonad.Actions.RotView (+                              -- * Usage+                              -- $usage+                              rotView+                             ) where++import Data.List ( sortBy, find )+import Data.Maybe ( isJust )+import Data.Ord ( comparing )++import XMonad+import XMonad.StackSet hiding (filter)++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.RotView+--+-- Then add appropriate key bindings, such as:+--+-- >   , ((modMask x .|. shiftMask, xK_Right), rotView True)+-- >   , ((modMask x .|. shiftMask, xK_Left), rotView False)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Cycle through non-empty workspaces.  True --> cycle in the forward+--   direction.  Note that workspaces cycle in order by tag, so if your+--   workspaces are not in tag-order, the cycling might seem wonky.+rotView :: Bool -> X ()+rotView forward = do+    ws <- gets windowset+    let currentTag = tag . workspace . current $ ws+        sortWs     = sortBy (comparing tag)+        isNotEmpty = isJust . stack+        sorted     = sortWs (hidden ws)+        pivoted    = let (a,b) = span ((< currentTag) . tag) sorted in b ++ a+        pivoted'   | forward   = pivoted+                   | otherwise = reverse pivoted+        nextws     = find isNotEmpty pivoted'+    whenJust nextws (windows . view . tag)
+ XMonad/Actions/SimpleDate.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.SimpleDate+-- Copyright   :  (c) Don Stewart 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  dons@cse.unsw.edu.au+-- Stability   :  stable+-- Portability :  portable+--+-- An example external contrib module for XMonad.+-- Provides a simple binding to dzen2 to print the date as a popup menu.+--+-----------------------------------------------------------------------------++module XMonad.Actions.SimpleDate (+                                 -- * Usage+                                 -- $usage+                                 date+                                ) where++import XMonad.Core+import XMonad.Util.Run++-- $usage+-- To use, import this module into @~\/.xmonad\/xmonad.hs@:+--+-- >     import XMonad.Actions.SimpleDate+--+-- and add a keybinding, for example:+--+-- >    , ((modMask x,               xK_d     ), date)+--+-- In this example, a popup date menu will now be bound to @mod-d@.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++date :: X ()+date = unsafeSpawn "(date; sleep 10) | dzen2"
+ XMonad/Actions/SinkAll.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module       : Xmonad.Actions.SinkAll+-- License      : BSD3-style (see LICENSE)+-- Stability    : unstable+-- Portability  : unportable+--+-- Provides a simple binding that pushes all floating windows on the current+-- workspace back into tiling.+-----------------------------------------------------------------------------++module XMonad.Actions.SinkAll (+    -- * Usage+    -- $usage+    sinkAll) where++import XMonad+import XMonad.StackSet++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.SinkAll+--+-- then add a keybinding; for example:+--+--     , ((modMask x .|. shiftMask, xK_t), sinkAll)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Un-float all floating windows on the current workspace.+sinkAll :: X ()+sinkAll = withAll sink++-- | Apply a function to all windows on current workspace.+withAll :: (Window -> WindowSet -> WindowSet) -> X ()+withAll f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws+                             in foldr f ws all'
+ XMonad/Actions/Submap.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Submap+-- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Jason Creighton <jcreigh@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module that allows the user to create a sub-mapping of key bindings.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Submap (+                             -- * Usage+                             -- $usage+                             submap+                            ) where++import XMonad hiding (keys)+import qualified Data.Map as M+import Control.Monad.Fix (fix)++{- $usage+++++First, import this module into your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Actions.Submap++Allows you to create a sub-mapping of keys. Example:++>    , ((modMask x, xK_a), submap . M.fromList $+>        [ ((0, xK_n),     spawn "mpc next")+>        , ((0, xK_p),     spawn "mpc prev")+>        , ((0, xK_z),     spawn "mpc random")+>        , ((0, xK_space), spawn "mpc toggle")+>        ])++So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to+trigger the submapping) and then 'n' to run that action. (0 means \"no+modifier\"). You are, of course, free to use any combination of+modifiers in the submapping. However, anyModifier will not work,+because that is a special value passed to XGrabKey() and not an actual+modifier.++For detailed instructions on editing your key bindings, see+"XMonad.Doc.Extending#Editing_key_bindings".++-}++-- | Given a 'Data.Map.Map' from key bindings to X () actions, return+--   an action which waits for a user keypress and executes the+--   corresponding action, or does nothing if the key is not found in+--   the map.+submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()+submap keys = do+    XConf { theRoot = root, display = d } <- ask++    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime++    (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do+        maskEvent d keyPressMask p+        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p+        keysym <- keycodeToKeysym d code 0+        if isModifierKey keysym+            then nextkey+            else return (m, keysym)++    io $ ungrabKeyboard d currentTime++    m' <- cleanMask m+    whenJust (M.lookup (m', s) keys) id
+ XMonad/Actions/SwapWorkspaces.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.SwapWorkspaces+-- Copyright   :  (c) Devin Mullins <me@twifkak.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Devin Mullins <me@twifkak.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Lets you swap workspace tags, so you can keep related ones next to+-- each other, without having to move individual windows.+--+-----------------------------------------------------------------------------++module XMonad.Actions.SwapWorkspaces (+                                     -- * Usage+                                     -- $usage+                                     swapWithCurrent,+                                     swapWorkspaces+                                    ) where++import XMonad.StackSet+++-- $usage+-- Add this import to your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.SwapWorkspaces+--+-- Then throw something like this in your keys definition:+--+-- > +++-- > [((modMask x .|. controlMask, k), windows $ swapWithCurrent i)+-- >     | (i, k) <- zip workspaces [xK_1 ..]]+--+-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5+-- will swap workspaces 1 and 5.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Swaps the currently focused workspace with the given workspace tag, via+--   @swapWorkspaces@.+swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd+swapWithCurrent t s = swapWorkspaces t (tag $ workspace $ current s) s++-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new+--   one with the two corresponding workspaces' tags swapped.+swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd+swapWorkspaces t1 t2 = mapWorkspace swap+    where swap w = if      tag w == t1 then w { tag = t2 }+                   else if tag w == t2 then w { tag = t1 }+                   else w
+ XMonad/Actions/TagWindows.hs view
@@ -0,0 +1,201 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.TagWindows+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>+-- License      : BSD+--+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- Functions for tagging windows and selecting them by tags.+-----------------------------------------------------------------------------++module XMonad.Actions.TagWindows (+                 -- * Usage+                 -- $usage+                 addTag, delTag, unTag,+                 setTags, getTags, hasTag,+                 withTaggedP,  withTaggedGlobalP, withFocusedP,+                 withTagged ,  withTaggedGlobal ,+                 focusUpTagged,   focusUpTaggedGlobal,+                 focusDownTagged, focusDownTaggedGlobal,+                 shiftHere, shiftToScreen,+                 tagPrompt,+                 tagDelPrompt+                 ) where++import Data.List (nub,concat,sortBy)+import Control.Monad++import XMonad.StackSet hiding (filter)++import XMonad.Prompt+import XMonad hiding (workspaces)++-- $usage+--+-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.TagWindows+-- > import XMonad.Prompt    -- to use tagPrompt+--+-- and add keybindings such as the following:+--+-- >   , ((modMask x,                 xK_f  ), withFocused (addTag "abc"))+-- >   , ((modMask x .|. controlMask, xK_f  ), withFocused (delTag "abc"))+-- >   , ((modMask x .|. shiftMask,   xK_f  ), withTaggedGlobal "abc" sink)+-- >   , ((modMask x,                 xK_d  ), withTaggedP "abc" (shiftWin "2"))+-- >   , ((modMask x .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)+-- >   , ((modMask x .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")+-- >   , ((modMask x,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))+-- >   , ((modMask x .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)+-- >   , ((modMask x .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))+-- >   , ((modWinMask,                xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (shiftWin "2")))+-- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))+-- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s))+--+-- NOTE: Tags are saved as space separated strings and split with+--       'unwords'. Thus if you add a tag \"a b\" the window will have+--       the tags \"a\" and \"b\" but not \"a b\".+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | set multiple tags for a window at once (overriding any previous tags)+setTags :: [String] -> Window -> X ()+setTags = setTag . unwords++-- | set a tag for a window (overriding any previous tags)+--   writes it to the \"_XMONAD_TAGS\" window property+setTag :: String -> Window -> X ()+setTag s w = withDisplay $ \d ->+    io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s++-- | read all tags of a window+--   reads from the \"_XMONAD_TAGS\" window property+getTags :: Window -> X [String]+getTags w = withDisplay $ \d ->+    io $ catch (internAtom d "_XMONAD_TAGS" False >>=+                getTextProperty d w >>=+                wcTextPropertyToTextList d)+               (\_ -> return [[]])+    >>= return . words . unwords++-- | check a window for the given tag+hasTag :: String -> Window -> X Bool+hasTag s w = (s `elem`) `fmap` getTags w++-- | add a tag to the existing ones+addTag :: String -> Window -> X ()+addTag s w = do+    tags <- getTags w+    if (s `notElem` tags) then setTags (s:tags) w else return ()++-- | remove a tag from a window, if it exists+delTag :: String -> Window -> X ()+delTag s w = do+    tags <- getTags w+    setTags (filter (/= s) tags) w++-- | remove all tags+unTag :: Window -> X ()+unTag = setTag ""++-- | Move the focus in a group of windows, which share the same given tag.+--   The Global variants move through all workspaces, whereas the other+--   ones operate only on the current workspace+focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()+focusUpTagged         = focusTagged' (reverse . wsToList)+focusDownTagged       = focusTagged' wsToList+focusUpTaggedGlobal   = focusTagged' (reverse . wsToListGlobal)+focusDownTaggedGlobal = focusTagged' wsToListGlobal++wsToList :: (Ord i) => StackSet i l a s sd -> [a]+wsToList ws = crs ++ cls+    where+        (crs, cls) = (cms down, cms (reverse . up))+        cms f = maybe [] f (stack . workspace . current $ ws)++wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]+wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])+    where+        curtag = tag . workspace . current $ ws+        (crs, cls) = (cms down, cms (reverse . up))+        cms f = maybe [] f (stack . workspace . current $ ws)+        (lws, rws) = (mws (<), mws (>))+        mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws+        sortByTag = sortBy (\x y -> compare (tag x) (tag y))++focusTagged' :: (WindowSet -> [Window]) -> String -> X ()+focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=+    maybe (return ()) (windows . focusWindow)++findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)+findM _ []      = return Nothing+findM p (x:xs)  = do b <- p x+                     if b then return (Just x) else findM p xs++-- | apply a pure function to windows with a tag+withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()+withTaggedP       t f = withTagged'       t (winMap f)+withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)++winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()+winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw))++withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()+withTagged       t f = withTagged'       t (mapM_ f)+withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)++withTagged' :: String -> ([Window] -> X ()) -> X ()+withTagged' t m = gets windowset >>=+    filterM (hasTag t) . integrate' . stack . workspace . current >>= m++withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()+withTaggedGlobal' t m = gets windowset >>=+    filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m++withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()+withFocusedP f = withFocused $ windows . f++shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd+shiftHere w s = shiftWin (tag . workspace . current $ s) w s++shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd+shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of+                                []      -> s+                                (t:_)   -> shiftWin (tag . workspace $ t) w s++data TagPrompt = TagPrompt++instance XPrompt TagPrompt where+    showXPrompt TagPrompt = "Select Tag:   "+++tagPrompt :: XPConfig -> (String -> X ()) -> X ()+tagPrompt c f = do+  sc <- tagComplList+  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f++tagComplList :: X [String]+tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=+    mapM getTags >>=+    return . nub . concat+++tagDelPrompt :: XPConfig -> X ()+tagDelPrompt c = do+  sc <- tagDelComplList+  if (sc /= [])+    then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))+    else return ()++tagDelComplList :: X [String]+tagDelComplList = gets windowset >>= maybe (return []) getTags . peek+++mkComplFunFromList' :: [String] -> String -> IO [String]+mkComplFunFromList' l [] = return l+mkComplFunFromList' l s =+  return $ filter (\x -> take (length s) x == s) l
+ XMonad/Actions/Warp.hs view
@@ -0,0 +1,71 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Warp+-- Copyright   :  (c) daniel@wagner-home.com+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  daniel@wagner-home.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Warp the pointer to a given window or screen.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Warp (+                           -- * Usage+                           -- $usage+                           warpToScreen,+                           warpToWindow+                          ) where++import Data.Ratio+import Data.List+import XMonad+import XMonad.StackSet as W++{- $usage+You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Actions.Warp++then add appropriate keybindings to warp the pointer; for example:++> , ((modMask x,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window+>+>-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3+>+>   [((modMask x .|. controlMask, key), warpToScreen sc (1%2) (1%2))+>       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]++Note that warping to a particular screen may change the focus.+-}++-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++fraction :: (Integral a, Integral b) => Rational -> a -> b+fraction f x = floor (f * fromIntegral x)++warp :: Window -> Position -> Position -> X ()+warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y++-- | Warp the pointer to a given position relative to the currently+--   focused window.  Top left = (0,0), bottom right = (1,1).+warpToWindow :: Rational -> Rational -> X ()+warpToWindow h v =+    withDisplay $ \d ->+        withFocused $ \w -> do+            wa <- io $ getWindowAttributes d w+            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))++-- | Warp the pointer to the given position (top left = (0,0), bottom+--   right = (1,1)) on the given screen.+warpToScreen :: ScreenId -> Rational -> Rational -> X ()+warpToScreen n h v = do+    root <- asks theRoot+    (StackSet {current = x, visible = xs}) <- gets windowset+    whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)+        $ \r ->+            warp root (rect_x r + fraction h (rect_width  r))+                      (rect_y r + fraction v (rect_height r))
+ XMonad/Actions/WindowBringer.hs view
@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.WindowBringer+-- Copyright   :  Devin Mullins <me@twifkak.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Devin Mullins <me@twifkak.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- dmenu operations to bring windows to you, and bring you to windows.+-- That is to say, it pops up a dmenu with window names, in case you forgot+-- where you left your XChat.+--+-----------------------------------------------------------------------------++module XMonad.Actions.WindowBringer (+                                    -- * Usage+                                    -- $usage+                                    gotoMenu, bringMenu, windowMapWith+                                   ) where++import Data.Char (toLower)+import qualified Data.Map as M++import qualified XMonad.StackSet as W+import XMonad+import qualified XMonad as X+import XMonad.Util.Dmenu (dmenuMap)+import XMonad.Util.NamedWindows (getName)++-- $usage+--+-- Import the module into your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.WindowBringer+--+-- and define appropriate key bindings:+--+-- > , ((modMask x .|. shiftMask, xK_g     ), gotoMenu)+-- > , ((modMask x .|. shiftMask, xK_b     ), bringMenu)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++-- | Pops open a dmenu with window titles. Choose one, and you will be+--   taken to the corresponding workspace.+gotoMenu :: X ()+gotoMenu = workspaceMap >>= actionMenu (windows . W.greedyView)+ where workspaceMap = windowMapWith (W.tag . fst)++-- | Pops open a dmenu with window titles. Choose one, and it will be+--   dragged, kicking and screaming, into your current workspace.+bringMenu :: X ()+bringMenu = windowMap >>= actionMenu (windows . bringWindow)+ where windowMap = windowMapWith snd+       bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws++-- | Calls dmenuMap to grab the appropriate element from the Map, and hands it+--   off to action if found.+actionMenu :: (a -> X ()) -> M.Map String a -> X ()+actionMenu action windowMap = dmenuMap windowMap >>= flip X.whenJust action++-- | Generates a Map from window name to \<whatever you specify\>. For+--   use with dmenuMap.+windowMapWith :: ((X.WindowSpace, Window) -> a) -> X (M.Map String a)+windowMapWith value = do -- TODO: extract the pure, creamy center.+  ws <- gets X.windowset+  M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)+ where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)+       keyValuePair ws w = flip (,) (value (ws, w)) `fmap` decorateName ws w++-- | Returns the window name as will be listed in dmenu.+--   Lowercased, for your convenience (since dmenu is case-sensitive).+--   Tagged with the workspace ID, to guarantee uniqueness, and to let the user+--   know where he's going.+decorateName :: X.WindowSpace -> Window -> X String+decorateName ws w = do+  name <- fmap (map toLower . show) $ getName w+  return $ name ++ " [" ++ W.tag ws ++ "]"
+ XMonad/Actions/WmiiActions.hs view
@@ -0,0 +1,106 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.WmiiActions+-- Copyright    : (c) Juraj Hercek <juhe_xmonad@hck.sk>+-- License      : BSD3+--+-- Maintainer   : Juraj Hercek <juhe_xmonad@hck.sk>+-- Stability    : unstable+-- Portability  : unportable+--+-- Provides \"actions\" as in the Wmii window manager+-- (<http://wmii.suckless.org>). It also provides a slightly better+-- interface for running dmenu on xinerama screens. If you want to use+-- xinerama functions, you have to apply the following patch (see the+-- "XMonad.Util.Dmenu" module):+-- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>.  Don't+-- forget to recompile dmenu afterwards ;-).+-----------------------------------------------------------------------------++module XMonad.Actions.WmiiActions (+                                 -- * Usage+                                 -- $usage+                                   wmiiActions+                                 , wmiiActionsXinerama+                                 , executables+                                 , executablesXinerama+                                 ) where++import XMonad+import XMonad.Util.Dmenu (dmenu, dmenuXinerama)+import XMonad.Util.Run (runProcessWithInput)++import Control.Monad (filterM, liftM, liftM2)+import System.Directory (getDirectoryContents, doesFileExist, getPermissions, executable)++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.WmiiActions+--+--  and add something like the following to your key bindings:+--+-- > ,((modMask x, xK_a), wmiiActions "/home/joe/.wmii-3.5/")+--+-- or, if you are using xinerama, you can use+--+-- > ,((modMask x, xK_a), wmiiActionsXinerama "/home/joe/.wmii-3.5/")+--+-- However, make sure you also have the xinerama build of dmenu (for more+-- information see the "XMonad.Util.Dmenu" extension).+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | The 'wmiiActions' function takes the file path as a first argument and+-- executes dmenu with all the executables found in the provided path.+wmiiActions :: FilePath -> X ()+wmiiActions path =+        wmiiActionsDmenu path dmenu++-- | The 'wmiiActionsXinerama'  does the same as 'wmiiActions', but it shows+-- dmenu only on the currently focused workspace.+wmiiActionsXinerama :: FilePath -> X ()+wmiiActionsXinerama path =+        wmiiActionsDmenu path dmenuXinerama++wmiiActionsDmenu :: FilePath -> ([String] -> X String) -> X ()+wmiiActionsDmenu path dmenuBrand =+        let path' = path ++ "/" in+        getExecutableFileList path' >>= dmenuBrand >>= spawn . (path' ++)++getExecutableFileList :: FilePath -> X [String]+getExecutableFileList path =+        io $ getDirectoryContents path >>=+             filterM (\x -> let x' = path ++ x in+                            liftM2 (&&)+                              (doesFileExist x')+                              (liftM executable (getPermissions x')))++{-+getExecutableFileList :: FilePath -> X [String]+getExecutableFileList path =+        io $ getDirectoryContents path >>=+             filterM (doesFileExist . (path ++)) >>=+             filterM (liftM executable . getPermissions . (path ++))+-}++-- | The 'executables' function runs the dmenu_path script, providing list of+-- executable files accessible from the $PATH variable.+executables :: X ()+executables = executablesDmenu dmenu++-- | The 'executablesXinerama' function does the same as the+-- 'executables' function, but on the workspace which currently has focus.+executablesXinerama :: X ()+executablesXinerama = executablesDmenu dmenuXinerama++executablesDmenu :: ([String] -> X String) -> X ()+executablesDmenu dmenuBrand =+        getExecutablesList >>= dmenuBrand >>= spawn++getExecutablesList :: X [String]+getExecutablesList =+        io $ liftM lines $ runProcessWithInput "dmenu_path" [] ""+
+ XMonad/Config/Arossato.hs view
@@ -0,0 +1,163 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Arossato+-- Copyright   :  (c) Andrea Rossato 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  stable+-- Portability :  portable+--+-- This module specifies my xmonad defaults.+--+------------------------------------------------------------------------++module XMonad.Config.Arossato+    ( -- * Usage+      -- $usage+      arossatoConfig+    , arossatoTabbedConfig+    ) where++import qualified Data.Map as M++import XMonad+import XMonad.ManageHook+import qualified XMonad.StackSet as W++import XMonad.Actions.CycleWS+import XMonad.Hooks.DynamicLog+import XMonad.Layout.Accordion+import XMonad.Layout.Magnifier+import XMonad.Layout.NoBorders+import XMonad.Layout.Tabbed+import XMonad.Prompt+import XMonad.Prompt.Shell+import XMonad.Prompt.Ssh+import XMonad.Prompt.Window+import XMonad.Prompt.XMonad++-- $usage+-- The simplest way to use this configuration module is to use an+-- @~\/.xmonad\/xmonad.hs@ like this:+--+-- > module Main (main) where+-- >+-- > import XMonad+-- > import XMonad.Config.Arossato (arossatoConfig)+-- >+-- > main :: IO ()+-- > main = xmonad arossatoConfig+--+--+-- You can use this module also as a starting point for writing your+-- own configuration module from scratch. Save it as your+-- @~\/.xmonad\/xmonad.hs@ and:+--+-- 1. Change the module name from+--+-- > module XMonad.Config.Arossato+-- >     ( -- * Usage+-- >       -- $usage+-- >       arossatoConfig+-- >     , arossatoTabbedConfig+-- >     ) where+--+-- to+--+-- > module Main where+--+-- 2. Add a line like:+--+-- > main = xmonad arossatoConfig+--+-- 3. Start playing with the configuration options...;)++-- | My configuration for the Tabbed Layout. Basically this is the+-- Ion3 clean style.+arossatoTabbedConfig :: TConf+arossatoTabbedConfig =+    defaultTConf { activeColor         = "#8a999e"+                 , inactiveColor       = "#545d75"+                 , activeBorderColor   = "white"+                 , inactiveBorderColor = "grey"+                 , activeTextColor     = "white"+                 , inactiveTextColor   = "grey"+                 , tabSize             = 15+                 }++arossatoConfig = defaultConfig+         { workspaces         = ["home","var","dev","mail","web","doc"] +++                                map show [7 .. 9 :: Int]+         , logHook            = dynamicLogXmobar+         , manageHook         = newManageHook+         , layoutHook         = noBorders mytab |||+                                magnifier tiled |||+                                noBorders Full  |||+                                tiled           |||+                                Mirror tiled    |||+                                Accordion+         , terminal           = "urxvt +sb"+         , normalBorderColor  = "white"+         , focusedBorderColor = "black"+         , keys               = newKeys+         , defaultGaps        = [(15,0,0,0)]+         }+    where+      -- layouts+      mytab = tabbed shrinkText arossatoTabbedConfig+      tiled = Tall 1 (3/100) (1/2)++      -- manageHook+      myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat+                                 , resource =? "win"          --> doF (W.shift "doc") -- xpdf+                                 , resource =? "firefox-bin"  --> doF (W.shift "web")+                                 ]+      newManageHook = myManageHook <+> manageHook defaultConfig++      -- key bindings stuff+      defKeys    = keys defaultConfig+      delKeys x  = foldr M.delete           (defKeys x) (toRemove x)+      newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)+      -- remove some of the default key bindings+      toRemove x =+          [ (modMask x              , xK_j)+          , (modMask x              , xK_k)+          , (modMask x              , xK_p)+          , (modMask x .|. shiftMask, xK_p)+          , (modMask x .|. shiftMask, xK_q)+          , (modMask x              , xK_q)+          ] +++          -- I want modMask .|. shiftMask 1-9 to be free!+          [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]+      -- These are my personal key bindings+      toAdd x   =+          [ ((modMask x              , xK_F12   ), xmonadPrompt      defaultXPConfig     )+          , ((modMask x              , xK_F3    ), shellPrompt       defaultXPConfig     )+          , ((modMask x              , xK_F4    ), sshPrompt         defaultXPConfig     )+          , ((modMask x              , xK_F5    ), windowPromptGoto  defaultXPConfig     )+          , ((modMask x              , xK_F6    ), windowPromptBring defaultXPConfig     )+          , ((modMask x              , xK_comma ), prevWS                                )+          , ((modMask x              , xK_period), nextWS                                )+          , ((modMask x              , xK_Right ), windows W.focusDown                   )+          , ((modMask x              , xK_Left  ), windows W.focusUp                     )+          -- other stuff: launch some useful utilities+          , ((modMask x              , xK_F2    ), spawn "urxvt -fg white -bg black +sb" )+          , ((modMask x .|. shiftMask, xK_F4    ), spawn "~/bin/dict.sh"                 )+          , ((modMask x .|. shiftMask, xK_F5    ), spawn "~/bin/urlOpen.sh"              )+          , ((modMask x .|. shiftMask, xK_t     ), spawn "~/bin/teaTime.sh"              )+          , ((modMask x              , xK_c     ), kill                                  )+          , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN   1 )         )+          , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1))         )+          -- commands fo the Magnifier layout+          , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)+          , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)+          , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )+          , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )+          ] +++          -- Use modMask .|. shiftMask .|. controlMask 1-9 instead+          [( (m .|. modMask x, k), windows $ f i)+           | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]+          ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]+          ]
+ XMonad/Config/Dons.hs view
@@ -0,0 +1,24 @@+--------------------------------------------------------------------+-- |+-- Module    : XMonad.Config.Dons+-- Copyright : (c) Galois, Inc. 2007+-- License   : BSD3+--+-- Maintainer: Don Stewart <dons@galois.com>+--+-- An example, simple configuration file.+--+--------------------------------------------------------------------++module XMonad.Config.Dons where++import XMonad+import XMonad.Hooks.DynamicLog++donsMain :: IO ()+donsMain = dzen $ \conf -> xmonad $ conf+        { borderWidth        = 2+        , terminal           = "term"+        , normalBorderColor  = "#cccccc"+        , focusedBorderColor = "#cd8b00" }+
+ XMonad/Config/Droundy.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Spencer Janssen 2007+-- License     :  BSD3-style (see LICENSE)+--+------------------------------------------------------------------------++module XMonad.Config.Droundy ( config, mytab ) where++--import Control.Monad.State ( modify )++import XMonad hiding (keys, config, (|||))+import qualified XMonad (keys)+import XMonad.Config ( defaultConfig )++--import XMonad.Core ( windowset )+import qualified XMonad.StackSet as W+import qualified Data.Map as M+import System.Exit++-- % Extension-provided imports++import XMonad.Layout.Tabbed+import XMonad.Layout.Combo+import XMonad.Layout.Mosaic+import XMonad.Layout.Named+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.Square+import XMonad.Layout.LayoutScreens+import XMonad.Layout.WindowNavigation+import XMonad.Layout.NoBorders+import XMonad.Layout.WorkspaceDir+import XMonad.Layout.ToggleLayouts++import XMonad.Prompt+import XMonad.Prompt.Layout+import XMonad.Prompt.Shell++import XMonad.Actions.CopyWindow+import XMonad.Actions.DynamicWorkspaces+import XMonad.Actions.RotView++--import XMonad.Hooks.ManageDocks+--import XMonad.Hooks.UrgencyHook++myXPConfig :: XPConfig+myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"+                             ,height=22}+++------------------------------------------------------------------------+-- Key bindings:++-- | The xmonad key bindings. Add, modify or remove key bindings here.+--+-- (The comment formatting character is used when generating the manpage)+--+keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())+keys x = M.fromList $+    -- launching and killing programs+    [ ((modMask x .|. shiftMask, xK_c     ), kill1) -- %! Close the focused window++    , ((modMask x,               xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms+    , ((modMask x .|. shiftMask, xK_space ), setLayout $ layoutHook x) -- %!  Reset the layouts on the current workspace to default++    -- move focus up or down the window stack+    , ((modMask x,               xK_Tab   ), windows W.focusDown) -- %! Move focus to the next window+    , ((modMask x,               xK_j     ), windows W.focusDown) -- %! Move focus to the next window+    , ((modMask x,               xK_k     ), windows W.focusUp  ) -- %! Move focus to the previous window++    , ((modMask x .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window+    , ((modMask x .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window++    -- floating layer support+    , ((modMask x,               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling++    -- quit, or restart+    , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad+    , ((modMask x              , xK_Escape), broadcastMessage ReleaseResources >> restart (Just "xmonad") True) -- %! Restart xmonad++    , ((modMask x .|. shiftMask, xK_z     ),+       layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))+    , ((modMask x .|. shiftMask .|. controlMask, xK_z),+       layoutScreens 1 (fixedLayout [Rectangle 0 0 1440 900]))+    , ((modMask x .|. shiftMask, xK_Right), rotView True)+    , ((modMask x .|. shiftMask, xK_Left), rotView False)+    , ((modMask x, xK_Right), sendMessage $ Go R)+    , ((modMask x, xK_Left), sendMessage $ Go L)+    , ((modMask x, xK_Up), sendMessage $ Go U)+    , ((modMask x, xK_Down), sendMessage $ Go D)+    , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R)+    , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L)+    , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U)+    , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)+ +    , ((0, xK_F2  ), spawn "gnome-terminal") -- %! Launch gnome-terminal+    , ((0, xK_F3  ), shellPrompt myXPConfig) -- %! Launch program+    , ((0, xK_F11   ), spawn "ksnapshot") -- %! Take snapshot+    , ((modMask x .|. shiftMask, xK_x     ), changeDir myXPConfig)+    , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)+    , ((modMask x .|. shiftMask, xK_v     ), selectWorkspace myXPConfig)+    , ((modMask x, xK_m     ), withWorkspace myXPConfig (windows . W.shift))+    , ((modMask x .|. shiftMask, xK_m     ), withWorkspace myXPConfig (windows . copy))+    , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)+    , ((modMask x, xK_l ), layoutPrompt myXPConfig)+    , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)++-- keybindings for Mosaic:+    , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))+    , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))+    , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))+    , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))+    , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))+    , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))+    , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))++    ]+ +    +++    zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])+    +++    zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])++config = -- withUrgencyHook FocusUrgencyHook $+         defaultConfig+         { borderWidth = 1 -- Width of the window border in pixels.+         , XMonad.workspaces = ["1:mutt","2:iceweasel"]+         , layoutHook = workspaceDir "~" $ windowNavigation $+                        toggleLayouts (noBorders Full) $ -- avoidStruts $+                        Named "tabbed" (noBorders mytab) |||+                        Named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||+                        Named "widescreen" ((mytab *||* mytab)+                                                ****//* combineTwo Square mytab mytab) --   |||+                        --mosaic 0.25 0.5+         , terminal = "xterm" -- The preferred terminal program.+         , normalBorderColor = "#dddddd" -- Border color for unfocused windows.+         , focusedBorderColor = "#00ff00" -- Border color for focused windows.+         , XMonad.modMask = mod1Mask+         , XMonad.keys = keys+         }++mytab = tabbed CustomShrink defaultTConf++instance Shrinker CustomShrink where+    shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' +    shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s+                 where n = length s+                       halfn = n `div` 2+                       rs = reverse s+                       cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs)+    shrinkIt _ s = shrinkIt shrinkText s++dropFromTail :: String -> String -> Maybe String+dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s+                 | otherwise = Nothing++dropFromHead :: String -> String -> Maybe String+dropFromHead h s | take (length h) s == h = Just $ drop (length h) s+                 | otherwise = Nothing++{-+data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show)++instance UrgencyHook FocusUrgencyHook Window where+    urgencyHook _ w = modify copyAndFocus+        where copyAndFocus s+                  | Just w == W.peek (windowset s) = s+                  | has w $ W.stack $ W.workspace $ W.current $ windowset s =+                      s { windowset = until ((Just w ==) . W.peek)+                                      W.focusUp $ windowset s }+                  | otherwise =+                      let t = W.tag $ W.workspace $ W.current $ windowset s+                      in s { windowset = until ((Just w ==) . W.peek)+                             W.focusUp $ copyWindow w t $ windowset s }+              has _ Nothing         = False+              has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)++-}
+ XMonad/Config/Sjanssen.hs view
@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module XMonad.Config.Sjanssen (sjanssenConfig) where++import XMonad hiding (Tall(..))+import qualified XMonad.StackSet as W+import XMonad.Actions.CopyWindow+import XMonad.Layout.Tabbed+import XMonad.Layout.HintedTile+import XMonad.Config (defaultConfig)+import XMonad.Layout.NoBorders+import XMonad.Hooks.DynamicLog+import XMonad.Hooks.ManageDocks+import XMonad.Prompt+import XMonad.Prompt.Shell+import XMonad.Util.Run (spawnPipe)++import qualified Data.Map as M+import System.IO (hPutStrLn)++sjanssenConfig = do+    xmobar <- spawnPipe "xmobar"+    return $ defaultConfig+        { terminal = "urxvt"+        , workspaces = ["irc", "web"] ++ map show [3 .. 7 :: Int] ++ ["mail", "im"]+        , logHook = dynamicLogWithPP $ sjanssenPP { ppOutput = hPutStrLn xmobar }+        , modMask = mod4Mask+        , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $+                [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))+                , ((modm, button2), (\w -> focus w >> windows W.swapMaster))+                , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]+        , keys = \c -> mykeys c `M.union` keys defaultConfig c+        , layoutHook = avoidStruts $ smartBorders (tiled Tall ||| tiled Wide ||| Full ||| tabbed shrinkText myTConf)+        , manageHook = manageHook defaultConfig <+> manageDocks+        }+ where+    tiled   = HintedTile 1 0.03 0.5++    mykeys (XConfig {modMask = modm, workspaces = ws}) = M.fromList $+        [((modm,               xK_p     ), shellPrompt myPromptConfig)+        ,((modm .|. shiftMask, xK_c     ), kill1)+        ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)+        ,((modm .|. shiftMask, xK_0     ), windows $ \w -> foldr copy w ws)+        ,((modm,               xK_b     ), sendMessage ToggleStruts)+        ]++    myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"+    myTConf = defaultTConf { fontName = myFont }+    myPromptConfig = defaultXPConfig+                        { position = Top+                        , font = myFont+                        , promptBorderWidth = 0 }
+ XMonad/Doc.hs view
@@ -0,0 +1,86 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This is the main documentation module for the xmonad-contrib+-- library. It provides a brief overview of xmonad and a link to+-- documentation for configuring and extending xmonad.+--+-- A link to documentation describing xmonad internals is also provided.+-- This module is mainly intended for those wanting to contribute code,+-- or for those who are curious to know what's going on behind the scenes.+-----------------------------------------------------------------------------++module XMonad.Doc+    (+    -- * Overview+    -- $overview++    -- * Configuring xmonad+    -- $configuring++    -- * Extending xmonad with the xmonad-contrib library+    -- $extending++    -- * Developing xmonad: an brief code commentary+    -- $developing++    ) where++import XMonad.Doc.Configuring ()+import XMonad.Doc.Extending ()+import XMonad.Doc.Developing ()++--------------------------------------------------------------------------------+--+--  Overview+--+--------------------------------------------------------------------------------++{- $overview+#Overview#++xmonad is a tiling window manager for X. The xmonad-contrib library+collects third party tiling algorithms, hooks, configurations,+scripts, and other extensions to xmonad.  The source for this library+is available from <http://code.haskell.org/XMonadContrib> via darcs:++> darcs get http://code.haskell.org/XMonadContrib++Each stable release of xmonad is accompanied by a stable release of+the contrib library, which you should use if (and only if) you're+using a stable release of xmonad.  You can find the most recent+(Oct. 2007) tarball here:+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib-0.5>++-}++{- $configuring++"XMonad.Doc.Configuring" documents the process of configuring+xmonad. A brief tutorial will guide you through the basic+configuration steps.++-}++{- $extending++"XMonad.Doc.Extending" is dedicated to the xmonad-contrib library+itself. You will find an overview of extensions available in the+library and instructions for using them.++-}++{- $developing++"XMonad.Doc.Developing" consists of a brief description of the xmonad+internals.  It is mainly intended for contributors and provides a+brief code commentary with links to the source documentation.++-}
+ XMonad/Doc/Configuring.hs view
@@ -0,0 +1,150 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Configuring+-- Copyright   :  (C) 2007 Don Stewart and Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This is a brief tutorial that will teach you how to create a+-- basic xmonad configuration.+--+-- For more detailed instructions on extending xmonad with the+-- xmonad-contrib library, see "XMonad.Doc.Extending".+--+-----------------------------------------------------------------------------++module XMonad.Doc.Configuring+    (+    -- * Configuring xmonad+    -- $configure++    -- * A simple example+    -- $example++    -- * Checking whether your xmonad.hs is correct+    -- $check++    -- * Loading your configuration+    -- $load++    ) where++--------------------------------------------------------------------------------+--+--  Configuring Xmonad+--+--------------------------------------------------------------------------------++{- $configure+#Configuring_xmonad#+xmonad can be configured by creating and editing the Haskell file:++>    ~/.xmonad/xmonad.hs++If this file does not exist, xmonad will simply use default settings;+if it does exist, xmonad will use whatever settings you specify.  Note+that this file can contain arbitrary Haskell code, which means that+you have quite a lot of flexibility in configuring xmonad.++NOTE for users of previous versions (< 0.5) of xmonad: this is a major+change in the way xmonad is configured.  Prior to version 0.5,+configuring xmonad required editing an xmonad source file called+Config.hs, recompiling xmonad, and then restarting.  From version 0.5+onwards, however, all you have to do is edit xmonad.hs and restart+with @mod-q@; xmonad does the recompiling itself.  The format of the+configuration file has also changed; it is now simpler and much+shorter, only requiring you to list those settings which are different+from the defaults.++-}++{- $example+#A_simple_example#++Here is a basic example, which starts with the default xmonad+configuration and overrides the border width, default terminal, and+some colours:++>    --+>    -- An example, simple ~/.xmonad/xmonad.hs file.+>    -- It overrides a few basic settings, reusing all the other defaults.+>    --+>+>    import XMonad+>+>    main = xmonad $ defaultConfig+>        { borderWidth        = 2+>        , terminal           = "urxvt"+>        , normalBorderColor  = "#cccccc"+>        , focusedBorderColor = "#cd8b00" }++This will run \'xmonad\', the window manager, with your settings+passed as arguments.++Overriding default settings like this (using \"record update+syntax\"), will yield the shortest config file, as you only have to+describe values that differ from the defaults.++An alternative is to inline the entire default config file from+xmonad, and edit values you wish to change. This is requires more+work, but some users may find this easier. You can find the defaults+in the "XMonad.Config" module of the core xmonad library.++However, note that (unlike previous versions of xmonad) you should not+edit Config.hs itself.++To see what fields can be customized beyond the ones in the example+above, the definition of the 'XMonad.Core.XConfig' data structure can+be found in "XMonad.Core".++-}++{- $check+#Checking_whether_your_xmonad.hs_is_correct#++After changing your configuration, it is a good idea to check that it+is syntactically and type correct.  You can do this easily by loading+your configuration file in the Haskell interpreter:++>    $ ghci ~/.xmonad/xmonad.hs+>    GHCi, version 6.8.1: http://www.haskell.org/ghc/  :? for help+>    Loading package base ... linking ... done.+>    Ok, modules loaded: Main.+>+>    Prelude Main> :t main+>    main :: IO ()++Ok, looks good.++Note, however, that if you skip this step and try restarting xmonad+with errors in your xmonad.hs, it's not the end of the world; xmonad+will simply display a window showing the errors and continue with the+previous configuration settings.++-}++{- $load+#Loading_your_configuration#++To get xmonad to use your new settings, type @mod-q@. xmonad will+attempt to compile this file, and run it.  If everything goes well,+xmonad will seamlessly restart itself with the new settings, keeping+all your windows, layouts, etc. intact.  (If you change anything+related to your layouts, you may need to hit @mod-shift-space@ after+restarting to see the changes take effect.)  If something goes wrong,+the previous (default) settings will be used.  Note this requires that+GHC and xmonad are in your @$PATH@. If GHC isn't in your path, you can+still compile @xmonad.hs@ yourself:++>    $ cd ~/.xmonad+>    $ /path/to/ghc --make xmonad.hs+>    $ ls+>    xmonad    xmonad.hi xmonad.hs xmonad.o++When you hit @mod-q@, this newly compiled xmonad will be used.++-}+
+ XMonad/Doc/Developing.hs view
@@ -0,0 +1,270 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Developing+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This module documents the xmonad internals. It is intended for+-- advanced users who are curious about the xmonad source code and+-- want an brief overview. This document may also be helpful for the+-- beginner\/intermediate Haskell programmer who is motivated to write+-- an xmonad extension as a way to deepen her understanding of this+-- powerful functional language; however, there is not space here to+-- go into much detail.  A more comprehensive document introducing+-- beginner\/intermediate Haskell programmers to the xmonad source is+-- planned for the xmonad users' wiki+-- (<http://haskell.org/haskellwiki/Xmonad>).+--+-- If you write an extension module and think it may be useful for+-- others, consider releasing it.  Coding guidelines and licensing+-- policies are covered at the end of this document, and must be+-- followed if you want your code to be included in the official+-- repositories.+--+-----------------------------------------------------------------------------++module XMonad.Doc.Developing+    (+    -- * Writing new extensions+    -- $writing++    -- * Libraries for writing window managers+    -- $xmonad-libs++    -- * xmonad internals+    -- $internals++    -- ** The @main@ entry point+    -- $main++    -- ** The X monad and the internal state+    -- $internalState++    -- ** Event handling and messages+    -- $events++    -- ** The 'LayoutClass'+    -- $layoutClass++    -- * Coding style+    -- $style++    -- * Licensing policy+    -- $license+    ) where++--------------------------------------------------------------------------------+--+--  Writing Extensions+--+--------------------------------------------------------------------------------++{- $writing+-}++{- $xmonad-libs++Starting with version 0.5, xmonad and xmonad-contrib are packaged and+distributed as libraries, instead of components which must be compiled+by the user into a binary (as they were prior to version 0.5). This+way of distributing xmonad has many advantages, since it allows+packaging by GNU\/Linux distributions while still allowing the user to+customize the window manager to fit her needs.++Basically, xmonad and the xmonad-contrib libraries let users write+their own window manager in just a few lines of code. While+@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration+file, it is actually a complete Haskell program which uses the xmonad+and xmonad-contrib libraries to create a custom window manager.++This makes it possible not only to edit the default xmonad+configuration, as we have seen in the "XMonad.Doc.Extending" document,+but to use the Haskell programming language to extend the window+manager you are writing in any way you see fit.++-}++{- $internals+-}++{- $main+#The_main_entry_point#++xmonad installs a binary, @xmonad@, which must be executed by the+Xsession starting script. This binary, whose code can be read in+@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile'+to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@.+If this compilation process fails, for any reason, a default @main@+entry point will be used, which calls the 'XMonad.Main.xmonad'+function with a default configuration.++Thus, the real @main@ entry point, the one that even the users' custom+window manager application in @~\/.xmonad\/xmonad.hs@ must call, is+the 'XMonad.Main.xmonad' function. This function takes a configuration+as its only argument, whose type ('XMonad.Core.XConfig')+is defined in "XMonad.Core".++'XMonad.Main.xmonad' takes care of opening the connection with the X+server, initializing the state (or deserializing it when restarted)+and the configuration, and calling the event handler+('XMonad.Main.handle') that goes into an infinite loop (using+'Prelude.forever') waiting for events and acting accordingly.++-}++{- $internalState++The event loop which calls 'XMonad.Main.handle' to react to events is+run within the 'XMonad.Core.X' monad, which is a+'Control.Monad.State.StateT' transformer over 'IO', encapsulated+within a 'Control.Monad.Reader.ReaderT' transformer. The+'Control.Monad.State.StateT' transformer encapsulates the+(read\/writable) state of the window manager (of type+'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT'+transformer encapsulates the (read-only) configuration (of type+'XMonad.Core.XConf').++Thanks to GHC's newtype deriving feature, the instance of the+'Control.Monad.State.MonadState' class parametrized over+'XMonad.Core.XState' and the instance of the+'Control.Monad.Reader.MonadReader' class parametrized over+'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X'+monad. This way we can use 'Control.Monad.State.get',+'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the+'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and+'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'.++'XMonad.Core.XState' is where all the sensitive information about+window management is stored. The most important field of the+'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type+('XMonad.Core.WindowSet') is a synonym for a+'XMonad.StackSet.StackSet' parametrized over a+'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside+the 'XMonad.Layout.Layout' existential data type, the+'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the+'XMonad.Core.ScreenDetail's.++What a 'XMonad.StackSet.StackSet' is and how it can be manipulated+with pure functions is described in the Haddock documentation of the+"XMonad.StackSet" module.++The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four+fields:++* 'XMonad.StackSet.current', for the current, focused workspace. This+  is a 'XMonad.StackSet.Screen', which is composed of a+  'XMonad.StackSet.Workspace' together with the screen information (for+  Xinerama support).++* 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for+  the other visible (with Xinerama) workspaces.  For non-Xinerama+  setups, this list is always empty.++* 'XMonad.StackSet.hidden', the list of non-visible+  'XMonad.StackSet.Workspace's.++* 'XMonad.StackSet.floating', a map from floating+  'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's+  specifying their geometry.++The 'XMonad.StackSet.Workspace' type is made of a+'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and+a (possibly empty) 'XMonad.StackSet.stack' of windows.++"XMonad.StackSet" (which should usually be imported qualified, to+avoid name clashes with Prelude functions such as 'Prelude.delete' and+'Prelude.filter') provides many pure functions to manipulate the+'XMonad.StackSet.StackSet'. These functions are most commonlyq used as+an argument to 'XMonad.Operations.windows', which takes a pure+function to manipulate the 'XMonad.Core.WindowSet' and does all the+needed operations to refresh the screen and save the modified+'XMonad.Core.XState'.++During each 'XMonad.Operations.windows' call, the+'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and+'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to+physically arrange the 'XMonad.StackSet.stack' of windows on each+workspace.++The possibility of manipulating the 'XMonad.StackSet.StackSet'+('XMonad.Core.WindowSet') with pure functions makes it possible to+test all the properties of those functions with QuickCheck, providing+greater reliability of the core code. Every change to the+"XMonad.StackSet" module must be accompanied by appropriate QuickCheck+properties before being applied.++-}++{- $events++Event handling is the core activity of xmonad.  Events generated by+the X server are most important, but there may also be events+generated by layouts or the user.++"XMonad.Core" defines a class that generalizes the concept of events,+'XMonad.Core.Message', constrained to types with a+'Data.Typeable.Typeable' instance definition (which can be+automatically derived by ghc). 'XMonad.Core.Message's are wrapped+within an existential type 'XMonad.Core.SomeMessage'. The+'Data.Typeable.Typeable' constraint allows for the definition of a+'XMonad.Core.fromMessage' function that can unwrap the message with+'Data.Typeable.cast'.  X Events are instances of this class, along+with any messages used by xmonad itself or by extension modules.++Using the 'Data.Typeable.Typeable' class for any kind of+'XMonad.Core.Message's and events allows us to define polymorphic functions+for processing messages or unhandled events.++This is precisely what happens with X events: xmonad passes them to+'XMonad.Main.handle'. If the main event handling function doesn't have+anything to do with the event, the event is sent to all visible+layouts by 'XMonad.Operations.broadcastMessage'.++This messaging system allows the user to create new message types,+simply declare an instance of the 'Data.Typeable.Typeable' and use+'XMonad.Operations.sendMessage' to send commands to layouts.++And, finally, layouts may handle X events and other messages within the+same function... miracles of polymorphism.++-}++{- $layoutClass+#The_LayoutClass#+to do+-}++{- $style++These are the coding guidelines for contributing to xmonad and the+xmonad contributed extensions.++* Comment every top level function (particularly exported funtions), and+  provide a type signature.++* Use Haddock syntax in the comments.++* Follow the coding style of the other modules.++* Code should be compilable with -Wall -Werror. There should be no warnings.++* Partial functions should be avoided: the window manager should not+  crash, so do not call 'error' or 'undefined'.++* Tabs are /illegal/. Use 4 spaces for indenting.++* Any pure function added to the core should have QuickCheck properties+  precisely defining its behaviour.++-}++{- $license++New modules should identify the author, and be submitted under the+same license as xmonad (BSD3 license or freer).++-}
+ XMonad/Doc/Extending.hs view
@@ -0,0 +1,872 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Extending+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This module documents the xmonad-contrib library and+-- how to use it to extend the capabilities of xmonad.+--+-- Reading this document should not require a deep knowledge of+-- Haskell; the examples are intended to be useful and understandable+-- for those users who do not know Haskell and don't want to have to+-- learn it just to configure xmonad.  You should be able to get by+-- just fine by ignoring anything you don't understand and using the+-- provided examples as templates.  However, relevant Haskell features+-- are discussed when appropriate, so this document will hopefully be+-- useful for more advanced Haskell users as well.+--+-- Those wishing to be totally hardcore and develop their own xmonad+-- extensions (it's easier than it sounds, we promise!) should read+-- the documentation in "XMonad.Doc.Developing".+--+-- More configuration examples may be found on the Haskell wiki:+--+-- <http://haskell.org/haskellwiki/Xmonad/Config_archive>+--+-----------------------------------------------------------------------------++module XMonad.Doc.Extending+    (+    -- * The xmonad-contrib library+    -- $library++    -- ** Actions+    -- $actions++    -- ** Configurations+    -- $configs++    -- ** Hooks+    -- $hooks++    -- ** Layouts+    -- $layouts++    -- ** Prompts+    -- $prompts++    -- ** Utilities+    -- $utils++    -- * Extending xmonad+    -- $extending++    -- ** Editing key bindings+    -- $keys++    -- *** Adding key bindings+    -- $keyAdding++    -- *** Removing key bindings+    -- $keyDel++    -- *** Adding and removing key bindings+    -- $keyAddDel++    -- ** Editing mouse bindings+    -- $mouse++    -- ** Editing the layout hook+    -- $layoutHook++    -- ** Editing the manage hook+    -- $manageHook++    -- ** The log hook and external status bars+    -- $logHook+    ) where++--------------------------------------------------------------------------------+--+--  The XmonadContrib Library+--+--------------------------------------------------------------------------------++{- $library++The xmonad-contrib (xmc) library is a set of extension modules+contributed by xmonad hackers and users, which provide additional+xmonad features.  Examples include various layout modes (tabbed,+spiral, three-column...), prompts, program launchers, the ability to+manipulate windows and workspaces in various ways, alternate+navigation modes, and much more.  There are also \"meta-modules\"+which make it easier to write new modules and extensions.++This is a concise yet complete overview of the xmonad-contrib modules.+For more information about any particular module, just click on its+name to view its Haddock documentation; each module should come with+extensive documentation.  If you find a module that could be better+documented, or has incorrect documentation, please report it as a bug+(<http://code.google.com/p/xmonad/issues/list>)!++-}++{- $actions++In the @XMonad.Actions@ namespace you can find modules exporting+various functions that are usually intended to be bound to key+combinations or mouse actions, in order to provide functionality+beyond the standard keybindings provided by xmonad.++See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to+edit your key bindings.++* "XMonad.Actions.Commands": running internal xmonad actions+  interactively.++* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained+  window resizing mode.++* "XMonad.Actions.CopyWindow": duplicating windows on multiple+  workspaces.++* "XMonad.Actions.CycleWS": move between workspaces.++* "XMonad.Actions.DeManage": cease management of a window without+  unmapping it.++* "XMonad.Actions.DwmPromote": dwm-like master window swapping.++* "XMonad.Actions.DynamicWorkspaces": add and delete workspaces.++* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace.++* "XMonad.Actions.FlexibleManipulate": move\/resize windows without+  warping the mouse.++* "XMonad.Actions.FlexibleResize": resize windows from any corner.++* "XMonad.Actions.FloatKeys": move\/resize floating windows with+  keybindings.++* "XMonad.Actions.FocusNth": focus the nth window on the screen.++* "XMonad.Actions.MouseGestures": bind mouse gestures to actions.++* "XMonad.Actions.RotSlaves": rotate non-master windows.++* "XMonad.Actions.RotView": cycle through non-empty workspaces.++* "XMonad.Actions.SimpleDate": display the date in a popup menu.++* "XMonad.Actions.SinkAll": sink all floating windows.++* "XMonad.Actions.Submap": create key submaps, i.e. the ability to+  bind actions to key sequences rather than being limited to single+  key combinations.++* "XMonad.Actions.SwapWorkspaces": swap workspace tags.++* "XMonad.Actions.TagWindows": tag windows and select by tag.++* "XMonad.Actions.Warp": warp the pointer.++* "XMonad.Actions.WindowBringer": bring windows to you, and you to+  windows.++* "XMonad.Actions.WmiiActions": wmii-style actions.++-}++{- $configs++In the @XMonad.Config@ namespace you can find modules exporting the+configurations used by some of the xmonad and xmonad-contrib+developers.  You can look at them for examples while creating your own+configuration; you can also simply import them and use them as your+own configuration, possibly with some modifications.++* "XMonad.Config.Arossato"++* "XMonad.Config.Dons"++* "XMonad.Config.Droundy"++* "XMonad.Config.Sjanssen"++-}++{- $hooks++In the @XMonad.Hooks@ namespace you can find modules exporting+hooks. Hooks are actions that xmonad performs when certain events+occur. The two most important hooks are:++* 'XMonad.Core.manageHook': this hook is called when a new window+  xmonad must take care of is created. This is a very powerful hook,+  since it lets us examine the new window's properties and act+  accordingly. For instance, we can configure xmonad to put windows+  belonging to a given application in the float layer, not to manage+  dock applications, or open them in a given workspace. See+  "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on+  customizing 'XMonad.Core.manageHook'.++* 'XMonad.Core.logHook': this hook is called when the stack of windows+  managed by xmonad has been changed, by calling the+  'XMonad.Operations.windows' function. For instance+  "XMonad.Hooks.DynamicLog" will produce a string (whose format can be+  configured) to be printed to the standard output. This can be used+  to display some information about the xmonad state in a status bar.+  See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more+  information.++Here is a list of the modules found in @XMonad.Hooks@:++* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send+  information about xmonad's state to standard output, suitable for+  putting in a status bar of some sort. See+  "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".++* "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications.++* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows appropriately.++* "XMonad.Hooks.SetWMName": set the WM name.  Useful when e.g. running+  Java GUI programs.++* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window+  sets the urgent flag.++* "XMonad.Hooks.XPropManage": match on XProperties in your+  'XMonad.Core.manageHook'.++-}++{- $layouts++In the @XMonad.Layout@ namespace you can find modules exporting+contributed tiling algorithms, such as a tabbed layout, a circle, a spiral,+three columns, and so on.++You will also find modules which provide facilities for combining+different layouts, such as "XMonad.Layout.Combo", or+"XMonad.Layout.LayoutCombinators".++Layouts can be also modified with layout modifiers. A general+interface for writing layout modifiers is implemented in+"XMonad.Layout.LayoutModifier".++For more information on using those modules for customizing your+'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook".++* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the+  top and bottom of the screen.++* "XMonad.Layout.Circle": an elliptical, overlapping layout.++* "XMonad.Layout.Combo": combine multiple layouts into one.++* "XMonad.Layout.Dishes": stack extra windows underneath the master windows.++* "XMonad.Layout.DragPane": split the screen into two windows with a+  draggable divider.++* "XMonad.Layout.Grid": put windows in a square grid.++* "XMonad.Layout.LayoutCombinators": general layout combining.++* "XMonad.Layout.LayoutHints": make layouts respect window size hints.++* "XMonad.Layout.LayoutModifier": a general framework for creating+  layout \"modifiers\"; useful for creating new layout modules.++* "XMonad.Layout.LayoutScreens": divide the screen into multiple+  virtual \"screens\".++* "XMonad.Layout.MagicFocus": automagically put the focused window in+  the master area.++* "XMonad.Layout.Magnifier": increase the size of the focused window++* "XMonad.Layout.Maximize": temporarily maximize the focused window.++* "XMonad.Layout.Mosaic": tries to give each window a+  user-configurable relative area++* "XMonad.Layout.MosaicAlt": give each window a specified relative+  amount of screen space.++* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout+  transformers.++* "XMonad.Layout.Named": change the names of layouts (as reported by+  e.g. "XMonad.Hooks.DynamicLog").++* "XMonad.Layout.NoBorders": display windows without borders.++* "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis.++* "XMonad.Layout.ResizableTile": tiled layout allowing you to change+  width and height of windows.++* "XMonad.Layout.Roledex": a \"completely pointless layout which acts+  like Microsoft's Flip 3D\".++* "XMonad.Layout.Spiral": Fibonacci spiral layout.++* "XMonad.Layout.Square": split the screen into a square area plus the rest.++* "XMonad.Layout.Tabbed": a tabbed layout.++* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two.++* "XMonad.Layout.TilePrime": fill gaps created by resize hints.++* "XMonad.Layout.ToggleLayouts": toggle between two layouts.++* "XMonad.Layout.TwoPane": split the screen horizontally and show two+  windows.++* "XMonad.Layout.WindowNavigation": navigate around a workspace+  directionally instead of using mod-j\/k.++* "XMonad.Layout.WorkspaceDir": set the current working directory in a+  workspace.++-}++{- $prompts++In the @XMonad.Prompt@ name space you can find modules providing+graphical prompts for getting user input and using it to perform+various actions.++The "XMonad.Prompt" provides a library for easily writing new prompt+modules.++These are the available prompts:++* "XMonad.Prompt.Directory"++* "XMonad.Prompt.Layout"++* "XMonad.Prompt.Man"++* "XMonad.Prompt.Shell"++* "XMonad.Prompt.Ssh"++* "XMonad.Prompt.Window"++* "XMonad.Prompt.Workspace"++* "XMonad.Prompt.XMonad"++Usually a prompt is called by some key binding. See+"XMonad.Doc.Extending#Editing_key_bindings", which includes examples+of adding some prompts.++-}++{- $utils++In the @XMonad.Util@ namespace you can find modules exporting various+utility functions that are used by the other modules of the+xmonad-contrib library.++There are also utilities for helping in configuring xmonad or using+external utilities.++A non complete list with a brief description:++* "XMonad.Util.Anneal": The goal is to bring the system, from an+  arbitrary initial state, to a state with the minimum possible+  energy.++* "XMonad.Util.CustomKeys" or "XMonad.Util.EZConfig" can be used to+  configure key bindings (see "XMonad.Doc.Extending#Editing_key_bindings");++* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for+  running dzen as a xmonad status bar and dmenu as a program launcher;++* "XMonad.Util.XSelection" provide utilities for using the mouse+  selection;++* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for+  accessing Xlib and XFT function in a convenient way.++-}++--------------------------------------------------------------------------------+--+--  Extending Xmonad+--+--------------------------------------------------------------------------------++{- $extending+#Extending_xmonad#++Since the @xmonad.hs@ file is just another Haskell module, you may+import and use any Haskell code or libraries you wish, such as+extensions from the xmonad-contrib library, or other code you write+yourself.++-}++{- $keys+#Editing_key_bindings#++Editing key bindings means changing the 'XMonad.Core.XConfig.keys'+field of the 'XMonad.Core.XConfig' record used by xmonad.  For+example, you could write:++>    main = xmonad $ defaultConfig { keys = myKeys }++and provide an appropriate definition of @myKeys@, such as:++>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]++This particular definition also requires importing "Graphics.X11.Xlib"+(for the symbols such as @xK_F12@), "XMonad.Prompt",+"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":++> import Graphics.X11.Xlib+> import ...  -- and so on++Usually, rather than completely redefining the key bindings, as we did+above, we want to simply add some new bindings and\/or remove existing+ones.++-}++{- $keyAdding+#Adding_key_bindings#++Adding key bindings can be done in different ways. The type signature+of 'XMonad.Core.XConfig.keys' is:++>    keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())++In order to add new key bindings, you need to first create an+appropriate 'Data.Map.Map' from a list of key bindings using+'Data.Map.fromList'.  This 'Data.Map.Map' of new key bindings then+needs to be joined to a 'Data.Map.Map' of existing bindings using+'Data.Map.union'.++Since we are going to need some of the functions of the "Data.Map"+module, before starting we must first import this modules:++>    import qualified Data.Map as M+++For instance, if you have defined some additional key bindings like+these:++>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]++then you can create a new key bindings map by joining the default one+with yours:++>    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))++Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field+of the configuration:++>    main = xmonad $ defaultConfig { keys = newKeys }++All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:+++>    module Main (main) where+>+>    import XMonad+>+>    import qualified Data.Map as M+>    import Graphics.X11.Xlib+>    import XMonad.Prompt+>    import XMonad.Prompt.Shell+>    import XMonad.Prompt.XMonad+>+>    main :: IO ()+>    main = xmonad $ defaultConfig { keys = newKeys }+>+>    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))+>+>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]+++There are other ways of defining @newKeys@; for instance,+you could define it like this:++>    newKeys x = foldr (uncurry M.insert) (keys defaultConfig x) (myKeys x)++However, the simplest way to add new key bindings is to use some+utilities provided by the xmonad-contrib library.  For instance,+"XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both provide+useful functions for editing your key bindings.  Look, for instance, at+'XMonad.Util.EZConfig.additionalKeys'.++ -}++{- $keyDel+#Removing_key_bindings#++Removing key bindings requires modifying the 'Data.Map.Map' which+stores the key bindings.  This can be done with 'Data.Map.difference'+or with 'Data.Map.delete'.++For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@+(you just want to leave xmonad running forever). To do this you need+to define @newKeys@ as a 'Data.Map.difference' between the default+map and the map of the key bindings you want to remove.  Like so:++>    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)+>+>    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]+>    keysToRemove x =+>             [ ((modMask x              , xK_q ), return ())+>             , ((modMask x .|. shiftMask, xK_q ), return ())+>             ]++As you can see, it doesn't matter what actions we associate with the+keys listed in @keysToRemove@, so we just use @return ()@ (the+\"null\" action).++It is also possible to simply define a list of keys we want to unbind+and then use 'Data.Map.delete' to remove them. In that case we would+write something like:++>    newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)+>+>    keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]+>    keysToRemove x =+>             [ (modMask x              , xK_q )+>             , (modMask x .|. shiftMask, xK_q )+>             ]++Another even simpler possibility is the use of some of the utilities+provided by the xmonad-contrib library. Look, for instance, at+'XMonad.Util.EZConfig.removeKeys'.++-}++{- $keyAddDel+#Adding_and_removing_key_bindings#++Adding and removing key bindings requires simply combining the steps+for removing and adding.  Here is an example from+"XMonad.Config.Arossato":++>    defKeys    = keys defaultConfig+>    delKeys x  = foldr M.delete           (defKeys x) (toRemove x)+>    newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)+>    -- remove some of the default key bindings+>    toRemove x =+>        [ (modMask x              , xK_j     )+>        , (modMask x              , xK_k     )+>        , (modMask x              , xK_p     )+>        , (modMask x .|. shiftMask, xK_p     )+>        , (modMask x .|. shiftMask, xK_q     )+>        , (modMask x              , xK_q     )+>        ] +++>        -- I want modMask .|. shiftMask 1-9 to be free!+>        [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]+>    -- These are my personal key bindings+>    toAdd x   =+>        [ ((modMask x              , xK_F12   ), xmonadPrompt defaultXPConfig )+>        , ((modMask x              , xK_F3    ), shellPrompt  defaultXPConfig )+>        ] +++>        -- Use modMask .|. shiftMask .|. controlMask 1-9 instead+>        [( (m .|. modMask x, k), windows $ f i)+>         | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]+>        ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]+>        ]++You can achieve the same result using the "XMonad.Util.CustomKeys"+module; take a look at the 'XMonad.Util.CustomKeys.customKeys'+function in particular.++-}++{- $mouse+#Editing_mouse_bindings#++Most of the previous discussion of key bindings applies to mouse+bindings as well.  For example, you could configure button4 to close+the window you click on like so:++>    import qualified Data.Map as M+>+>    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]+>+>    newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))+>+>    main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }++Overriding or deleting mouse bindings works similarly.  You can also+configure mouse bindings much more easily using the+'XMonad.Util.EZConfig.additionalMouseBindings' and+'XMonad.Util.EZConfig.removeMouseBindings' functions from the+"XMonad.Util.EZConfig" module.++-}++{- $layoutHook+#Editing_the_layout_hook#++When you start an application that opens a new window, when you change+the focused window, or move it to another workspace, or change that+workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for+reordering the visible windows on the visible workspace(s).++Since different layouts may be attached to different workspaces, and+you can change them, xmonad needs to know which one to use. In this+sense the layoutHook may be thought as the list of layouts that+xmonad will use for laying out windows on the screen(s).++The problem is that the layout subsystem is implemented with an+advanced feature of the Haskell programming language: type classes.+This allows us to very easily write new layouts, combine or modify+existing layouts, create layouts with internal state, etc. See+"XMonad.Doc.Extending#The_LayoutClass" for more information. This+means that we cannot simply have a list of layouts as we used to have+before the 0.5 release: a list requires every member to belong to the+same type!++Instead the combination of layouts to be used by xmonad is created+with a specific layout combinator: 'XMonad.Layout.|||'.++Suppose we want a list with the 'XMonad.Layout.Full',+'XMonad.Layout.Tabbed.tabbed' and+'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our+@~\/.xmonad\/xmonad.hs@, all the needed modules:++>    import XMonad+>    import XMonad.Layouts+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion++Then we create the combination of layouts we need:++>    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion+++Now, all we need to do is change the 'XMonad.Core.layoutHook'+field of the 'XMonad.Core.XConfig' record, like so:++>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }++Thanks to the new combinator, we can apply a layout modifier to a+whole combination of layouts, instead of applying it to each one. For+example, suppose we want to use the+'XMonad.Layout.NoBorders.noBorders' layout modifier, from the+"XMonad.Layout.NoBorders" module (which must be imported):++>    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)++If we want only the tabbed layout without borders, then we may write:++>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion++Our @~\/.xmonad\/xmonad.hs@ will now look like this:++>    import XMonad.Layouts+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion+>    import XMonad.Layout.NoBorders+>+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion+>+>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }++That's it!++-}++{- $manageHook+#Editing_the_manage_hook#++The 'XMonad.Core.manageHook' is a very powerful tool for customizing+the behavior of xmonad with regard to new windows.  Whenever a new+window is created, xmonad calls the 'XMonad.Core.manageHook', which+can thus be used to perform certain actions on the new window, such as+placing it in a specific workspace, ignoring it, or placing it in the+float layer.++The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer+and Gimp, and to ignore gnome-panel, desktop_window, kicker, and+kdesktop.++The "XMonad.ManageHook" module provides some simple combinators that+can be used to alter the 'XMonad.Core.manageHook' by replacing or adding+to the default actions.++Let's start by analyzing the default 'XMonad.Config.manageHook', defined+in "XMonad.Config":+++>    manageHook :: ManageHook+>    manageHook = composeAll+>                    [ className =? "MPlayer"        --> doFloat+>                    , className =? "Gimp"           --> doFloat+>                    , resource  =? "desktop_window" --> doIgnore+>                    , resource  =? "kdesktop"       --> doIgnore ]++'XMonad.ManageHook.composeAll' can be used to compose a list of+different 'XMonad.Config.ManageHook's. In this example we have a list+of 'XMonad.Config.ManageHook's formed by the following commands: the+Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className'+are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the+float layer with the 'XMonad.ManageHook.doFloat' function; the windows+whose resource names are respectively \"desktop_window\" and+\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore'+function.++This is another example of 'XMonad.Config.manageHook', taken from+"XMonad.Config.Arossato":++>    myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat+>                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf+>                               , resource =? "firefox-bin"  --> doF (W.shift "web")+>                               ]+>    newManageHook = myManageHook <+> manageHook defaultConfig+++Again we use 'XMonad.ManageHook.composeAll' to compose a list of+different 'XMonad.Config.ManageHook's. The first one will put+RealPlayer on the float layer, the second one will put the xpdf+windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF'+and 'XMonad.StackSet.shift' functions, and the third one will put all+firefox windows on the workspace called "web". Then we use the+'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the+default 'XMonad.Config.manageHook' to form @newManageHook@.++Each 'XMonad.Config.ManageHook' has the form:++>    property =? match --> action++Where @property@ can be:++* 'XMonad.ManageHook.title': the window's title++* 'XMonad.ManageHook.resource': the resource name++* 'XMonad.ManageHook.className': the resource class name.++(You can retrieve the needed information using the X utility named+@xprop@; for example, to find the resource class name, you can type++> xprop | grep WM_CLASS++at a prompt, then click on the window whose resource class you want to+know.)++@match@ is the string that will match the property value (for instance+the one you retrieved with @xprop@).++An  @action@ can be:++* 'XMonad.ManageHook.doFloat': to place the window in the float layer;++* 'XMonad.ManageHook.doIgnore': to ignore the window;++* 'XMonad.ManageHook.doF': to execute a function with the window as+  argument.++For example, suppose we want to add a 'XMonad.Config.manageHook' to+float RealPlayer, which usually has a 'XMonad.ManageHook.resource'+name of \"realplay.bin\".++First we need to import "XMonad.ManageHook":++>    import XMonad.ManageHook++Then we create our own 'XMonad.Config.manageHook':++>    myManageHook = resource =? "realplay.bin" --> doFloat++We can now use the 'XMonad.ManageHook.<+>' combinator to add our+'XMonad.Config.manageHook' to the default one:++>    newManageHook = myManageHook <+> manageHook defaultConfig++(Of course, if we wanted to completely replace the default+'XMonad.Config.manageHook', this step would not be necessary.) Now,+all we need to do is change the 'XMonad.Core.manageHook' field of the+'XMonad.Core.XConfig' record, like so:++>    main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }++And we are done.++Obviously, we may wish to add more then one+'XMonad.Config.manageHook'. In this case we can use a list of hooks,+compose them all with 'XMonad.ManageHook.composeAll', and add the+composed to the default one.++For instance, if we want RealPlayer to float and thunderbird always+opened in the workspace named "mail", we can do so like this:++>    myManageHook = composeAll [ resource =? "realplay.bin"    --> doFloat+>                              , resource =? "thunderbird-bin" --> doF (W.shift "mail")+>                              ]++Remember to import the module that defines the 'XMonad.StackSet.shift'+function, "XMonad.StackSet", like this:++>    import qualified XMonad.StackSet as W++And then we can add @myManageHook@ to the default one to create+@newManageHook@ as we did in the previous example.++One more thing to note about this system is that if+a window matches multiple rules in a 'XMonad.Config.manageHook', /all/+of the corresponding actions will be run (in the order in which they+are defined).  This is a change from versions before 0.5, when only+the first rule that matched was run.++-}++{- $logHook+#The_log_hook_and_external_status_bars#++When the stack of the windows managed by xmonad changes for any+reason, xmonad will call 'XMonad.Core.logHook', which can be used to+output some information about the internal state of xmonad, such as the+layout that is presently in use, the workspace we are in, the focused+window's title, and so on.++Extracting information about the internal xmonad state can be somewhat+difficult if you are not familiar with the source code. Therefore,+it's usually easiest to use a module that has been designed+specifically for logging some of the most interesting information+about the internal state of xmonad: "XMonad.Hooks.DynamicLog".  This+module can be used with an external status bar to print the produced+logs in a convenient way; the most commonly used status bars are dzen+and xmobar.++By default the 'XMonad.Core.logHook' doesn't produce anything. To+enable it you need first to import "XMonad.Hooks.DynamicLog":++>    import XMonad.Hooks.DynamicLog++Then you just need to update the 'XMonad.Core.logHook' field of the+'XMonad.Core.XConfig' record with one of the provided functions. For+example:++>    main = xmonad defaultConfig { logHook = dynamicLog }++More interesting configurations are also possible; see the+"XMonad.Hooks.DynamicLog" module for more possibilities.++You may now enjoy your extended xmonad experience.++Have fun!++-}
+ XMonad/Hooks/DynamicLog.hs view
@@ -0,0 +1,254 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DynamicLog+-- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>+-- Stability   :  unstable+-- Portability :  unportable+--+-- DynamicLog+--+-- Log events in:+--+-- >     1 2 [3] 4 8+--+-- format. Suitable to pipe into dzen.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DynamicLog (+    -- * Usage+    -- $usage +    dynamicLog,+    dynamicLogDzen,+    dynamicLogXmobar,+    dynamicLogWithPP,+    dynamicLogXinerama,+    dzen,++    pprWindowSet,+    pprWindowSetXinerama,++    PP(..), defaultPP, dzenPP, sjanssenPP,+    wrap, pad, shorten,+    xmobarColor, dzenColor, dzenEscape,+    makeSimpleDzenConfig+  ) where++-- +-- Useful imports+--+import XMonad+import Data.Maybe ( isJust )+import Data.List+import Data.Ord ( comparing )+import qualified XMonad.StackSet as S+import Data.Monoid+import System.IO+import XMonad.Util.NamedWindows+import XMonad.Util.Run++-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad+-- >    import XMonad.Hooks.DynamicLog+-- >    main = xmonad defaultConfig { logHook = dynamicLog }++-- | An example xmonad config that spawns a new dzen toolbar and uses the default+-- dynamic log output+makeSimpleDzenConfig :: IO (XConfig (Choose Tall (Choose (Mirror Tall) Full)))+makeSimpleDzenConfig = do+  h <- spawnPipe "dzen2"+  return defaultConfig+           { defaultGaps = [(18,0,0,0)]+           , logHook = dynamicLogWithPP dzenPP+                                          { ppOutput = hPutStrLn h } }++-- | +--+-- Run xmonad with a dzen status bar set to some nice defaults. Output +-- is taken from the dynamicLogWithPP hook.+--+-- > main = dzen xmonad+--+-- The intent is that the above config file should provide a nice status+-- bar with minimal effort.+--+dzen :: (XConfig (Choose Tall (Choose (Mirror Tall) Full)) -> IO ()) -> IO ()+dzen f = do+  h <- spawnPipe ("dzen2" ++ " " ++ flags)+  f $ defaultConfig+           { defaultGaps = [(15,0,0,0)] -- for fixed+           , logHook = dynamicLogWithPP dzenPP+                          { ppOutput = hPutStrLn h } }+ where+    fg      = "'#a8a3f7'" -- n.b quoting+    bg      = "'#3f3c6d'"+    flags   = "-e '' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg++-- |+-- An example log hook, print a status bar output to stdout, in the form:+--+-- > 1 2 [3] 4 7 : full : title+--+-- That is, the currently populated workspaces, the current+-- workspace layout, and the title of the focused window.+--+dynamicLog :: X ()+dynamicLog = dynamicLogWithPP defaultPP++-- |+-- A log function that uses the 'PP' hooks to customize output.+dynamicLogWithPP :: PP -> X ()+dynamicLogWithPP pp = do+    spaces <- asks (workspaces . config)+    -- layout description+    ld <- withWindowSet $ return . description . S.layout . S.workspace . S.current+    -- workspace list+    ws <- withWindowSet $ return . pprWindowSet spaces pp+    -- window title+    wt <- withWindowSet $ maybe (return "") (fmap show . getName) . S.peek++    io . ppOutput pp . sepBy (ppSep pp) . ppOrder pp $+                        [ ws+                        , ppLayout pp ld+                        , ppTitle  pp wt+                        ]++-- | An example log hook that emulates dwm's status bar, using colour codes printed to dzen+-- Requires dzen. Workspaces, xinerama, layouts and the window title are handled.+--+dynamicLogDzen :: X ()+dynamicLogDzen = dynamicLogWithPP dzenPP+++pprWindowSet :: [String] -> PP -> WindowSet -> String+pprWindowSet spaces pp s =  sepBy (ppWsSep pp) $ map fmt $ sortBy cmp+            (map S.workspace (S.current s : S.visible s) ++ S.hidden s)+   where f Nothing Nothing   = EQ+         f (Just _) Nothing  = LT+         f Nothing (Just _)  = GT+         f (Just x) (Just y) = compare x y++         wsIndex = flip elemIndex spaces . S.tag++         cmp a b = f (wsIndex a) (wsIndex b) `mappend` compare (S.tag a) (S.tag b)++         this     = S.tag (S.workspace (S.current s))+         visibles = map (S.tag . S.workspace) (S.visible s)++         fmt w = printer pp (S.tag w)+          where printer | S.tag w == this         = ppCurrent+                        | S.tag w `elem` visibles = ppVisible+                        | isJust (S.stack w)      = ppHidden+                        | otherwise               = ppHiddenNoWindows++-- |+-- Workspace logger with a format designed for Xinerama:+--+-- > [1 9 3] 2 7+--+-- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,+-- and 2 and 7 are non-visible, non-empty workspaces+--+dynamicLogXinerama :: X ()+dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama++pprWindowSetXinerama :: WindowSet -> String+pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen+  where onscreen  = map (S.tag . S.workspace)+                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws+        offscreen = map S.tag . filter (isJust . S.stack)+                        . sortBy (comparing S.tag) $ S.hidden ws++wrap :: String -> String -> String -> String+wrap _ _ "" = ""+wrap l r m  = l ++ m ++ r++pad :: String -> String+pad = wrap " " " "++shorten :: Int -> String -> String+shorten n xs | length xs < n = xs+             | otherwise     = (take (n - length end) xs) ++ end+ where+    end = "..."++sepBy :: String -> [String] -> String+sepBy sep = concat . intersperse sep . filter (not . null)++dzenColor :: String -> String -> String -> String+dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)+ where (fg1,fg2) | null fg = ("","")+                 | otherwise = ("^fg(" ++ fg ++ ")","^fg()")+       (bg1,bg2) | null bg = ("","")+                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")++-- | Escape any dzen metacharacters.+dzenEscape :: String -> String+dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])++xmobarColor :: String -> String -> String -> String+xmobarColor fg bg = wrap t "</fc>"+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]++-- | The 'PP' type allows the user to customize various behaviors of+-- dynamicLogPP+data PP = PP { ppCurrent, ppVisible+             , ppHidden, ppHiddenNoWindows :: WorkspaceId -> String+             , ppSep, ppWsSep :: String+             , ppTitle :: String -> String+             , ppLayout :: String -> String+             , ppOrder :: [String] -> [String]+             , ppOutput :: String -> IO ()+             }++-- | The default pretty printing options, as seen in dynamicLog+defaultPP :: PP+defaultPP = PP { ppCurrent         = wrap "[" "]"+               , ppVisible         = wrap "<" ">"+               , ppHidden          = id+               , ppHiddenNoWindows = const ""+               , ppSep             = " : "+               , ppWsSep           = " "+               , ppTitle           = shorten 80+               , ppLayout          = id+               , ppOrder           = id+               , ppOutput          = putStrLn+               }++-- | Settings to emulate dwm's statusbar, dzen only+dzenPP :: PP+dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad+                     , ppVisible  = dzenColor "black" "#999999" . pad+                     , ppHidden   = dzenColor "black" "#cccccc" . pad+                     , ppHiddenNoWindows = const ""+                     , ppWsSep    = ""+                     , ppSep      = ""+                     , ppLayout   = dzenColor "black" "#cccccc" .+                                    (\ x -> case x of+                                              "TilePrime Horizontal" -> " TTT "+                                              "TilePrime Vertical"   -> " []= "+                                              "Hinted Full"          -> " [ ] "+                                              _                      -> pad x+                                    )+                     , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape+                     }++-- | The options that sjanssen likes to use, as an example.  Note the use of+-- 'xmobarColor' and the record update on defaultPP+sjanssenPP :: PP+sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "#ff000000"+                       , ppTitle = xmobarColor "#00ee00" "" . shorten 80+                       }++-- | These are good defaults to be used with the xmobar status bar+dynamicLogXmobar :: X ()+dynamicLogXmobar = +    dynamicLogWithPP defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"+                               , ppTitle   = xmobarColor "green"  "" . shorten 40+                               , ppVisible = wrap "(" ")"+                               }
+ XMonad/Hooks/EwmhDesktops.hs view
@@ -0,0 +1,130 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.EwmhDesktops+-- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>+-- License      : BSD+--+-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- Makes xmonad use the EWMH hints to tell panel applications about its+-- workspaces and the windows therein.+-----------------------------------------------------------------------------+module XMonad.Hooks.EwmhDesktops (+    -- * Usage+    -- $usage+    ewmhDesktopsLogHook+    ) where++import Data.List    (elemIndex, sortBy)+import Data.Ord     (comparing)+import Data.Maybe   (fromMaybe)++import XMonad+import Control.Monad+import qualified XMonad.StackSet as W++import XMonad.Hooks.SetWMName++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Hooks.EwmhDesktops+-- >+-- > myLogHook :: X ()+-- > myLogHook = do ewmhDesktopsLogHook+-- >                return ()+-- >+-- > main = xmonad defaultConfig { logHook = myLogHook }+-- +-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"++-- | +-- Notifies pagers and window lists, such as those in the gnome-panel+-- of the current state of workspaces and windows.+ewmhDesktopsLogHook :: X ()+ewmhDesktopsLogHook = withWindowSet $ \s -> do+    -- Bad hack because xmonad forgets the original order of things, it seems+    -- see http://code.google.com/p/xmonad/issues/detail?id=53+    let ws = sortBy (comparing W.tag) $ W.workspaces s+    let wins = W.allWindows s++    setSupported++    -- Number of Workspaces+    setNumberOfDesktops (length ws)++    -- Names thereof+    setDesktopNames (map W.tag ws)++    -- Current desktop+    fromMaybe (return ()) $ do+        n <- W.lookupWorkspace 0 s+        i <- elemIndex n $ map W.tag ws+        return $ setCurrentDesktop i++    setClientList wins++    -- Per window Desktop+    forM (zip ws [(0::Int)..]) $ \(w, wn) ->+        forM (W.integrate' (W.stack w)) $ \win -> do+            setWindowDesktop win wn++    return ()+++setNumberOfDesktops :: (Integral a) => a -> X ()+setNumberOfDesktops n = withDisplay $ \dpy -> do+    a <- getAtom "_NET_NUMBER_OF_DESKTOPS"+    c <- getAtom "CARDINAL"+    r <- asks theRoot+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]++setCurrentDesktop :: (Integral a) => a -> X ()+setCurrentDesktop i = withDisplay $ \dpy -> do+    a <- getAtom "_NET_CURRENT_DESKTOP"+    c <- getAtom "CARDINAL"+    r <- asks theRoot+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]++setDesktopNames :: [String] -> X ()+setDesktopNames names = withDisplay $ \dpy -> do+    -- Names thereof+    r <- asks theRoot+    a <- getAtom "_NET_DESKTOP_NAMES"+    c <- getAtom "UTF8_STRING"+    let names' = map (fromIntegral.fromEnum) $+            concatMap (("Workspace "++) . (++['\0'])) names+    io $ changeProperty8 dpy r a c propModeReplace names'++setClientList :: [Window] -> X ()+setClientList wins = withDisplay $ \dpy -> do+    -- (What order do we really need? Something about age and stacking)+    r <- asks theRoot+    c <- getAtom "WINDOW"+    a <- getAtom "_NET_CLIENT_LIST"+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)+    a' <- getAtom "_NET_CLIENT_LIST_STACKING"+    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)++setWindowDesktop :: (Integral a) => Window -> a -> X ()+setWindowDesktop win i = withDisplay $ \dpy -> do+    a <- getAtom "_NET_WM_DESKTOP"+    c <- getAtom "CARDINAL"+    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]++setSupported :: X ()+setSupported = withDisplay $ \dpy -> do+    r <- asks theRoot+    a <- getAtom "_NET_SUPPORTED"+    c <- getAtom "ATOM"+    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"]+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)++    setWMName "xmonad"++
+ XMonad/Hooks/ManageDocks.hs view
@@ -0,0 +1,152 @@+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}+{-# OPTIONS -fglasgow-exts #-}+-- deriving Typeable+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.ManageDocks+-- Copyright    : (c) Joachim Breitner <mail@joachim-breitner.de>+-- License      : BSD+--+-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- This module provides tools to automatically manage 'dock' type programs,+-- such as gnome-panel, kicker, dzen, and xmobar.++module XMonad.Hooks.ManageDocks (+    -- * Usage+    -- $usage+    manageDocks, AvoidStruts, avoidStruts, ToggleStruts(ToggleStruts)+    ) where+++-----------------------------------------------------------------------------+import XMonad+import Foreign.C.Types (CLong)+import Data.Maybe (catMaybes)+-- $usage+-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.ManageDocks+--+-- The first component is a 'ManageHook' which recognizes these windows.  To+-- enable it:+--+-- > manageHook = ... <+> manageDocks+--+-- The second component is a layout modifier that prevents windows from+-- overlapping these dock windows.  It is intended to replace xmonad's+-- so-called "gap" support.  First, you must add it to your list of layouts:+--+-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)+--+-- 'AvoidStruts' also supports toggling the dock gap, add a keybinding similar+-- to:+--+-- > ,((modMask,               xK_b     ), sendMessage ToggleStruts)+--++-- |+-- Detects if the given window is of type DOCK and if so, reveals it, but does+-- not manage it. If the window has the STRUT property set, adjust the gap accordingly.+manageDocks :: ManageHook+manageDocks = checkDock --> doIgnore++-- |+-- Checks if a window is a DOCK window+checkDock :: Query Bool+checkDock = ask >>= \w -> liftX $ do+    a <- getAtom "_NET_WM_WINDOW_TYPE"+    d <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+    mbr <- getProp a w+    case mbr of+        Just [r] -> return (fromIntegral r == d)+        _        -> return False++-- |+-- Gets the STRUT config, if present, in xmonad gap order+getStrut :: Window -> X (Maybe (Int, Int, Int, Int))+getStrut w = do+    a <- getAtom "_NET_WM_STRUT"+    mbr <- getProp a w+    case mbr of+        Just [l,r,t,b] -> return (Just (+                    fromIntegral t,+                    fromIntegral b,+                    fromIntegral l,+                    fromIntegral r))+        _              -> return Nothing++-- |+-- Helper to read a property+getProp :: Atom -> Window -> X (Maybe [CLong])+getProp a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w++-- |+-- Goes through the list of windows and find the gap so that all STRUT+-- settings are satisfied.+calcGap :: X Rectangle+calcGap = withDisplay $ \dpy -> do+    rootw <- asks theRoot+    -- We don't keep track of dock like windows, so we find all of them here+    (_,_,wins) <- io $ queryTree dpy rootw+    struts <- catMaybes `fmap` mapM getStrut wins++    -- we grab the window attributes of the root window rather than checking+    -- the width of the screen because xlib caches this info and it tends to+    -- be incorrect after RAndR+    wa <- io $ getWindowAttributes dpy rootw+    return $ reduceScreen (foldl max4 (0,0,0,0) struts)+                $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)++-- |+-- Piecewise maximum of a 4-tuple of Ints+max4 :: (Int, Int, Int, Int) -> (Int, Int, Int, Int) -> (Int, Int, Int, Int)+max4 (a1,a2,a3,a4) (b1,b2,b3,b4) = (max a1 b1, max a2 b2, max a3 b3, max a4 b4)++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++-- | Given strut values and the screen rectangle, compute a reduced screen+-- rectangle.+reduceScreen :: (Int, Int, Int, Int) -> Rectangle -> Rectangle+reduceScreen (t, b, l, r) (Rectangle rx ry rw rh)+ = Rectangle (rx + fi l) (ry + fi t) (rw - fi r) (rh - fi b)++r2c :: Rectangle -> (Position, Position, Position, Position)+r2c (Rectangle x y w h) = (x, y, x + fi w, y + fi h)++c2r :: (Position, Position, Position, Position) -> Rectangle+c2r (x1, y1, x2, y2) = Rectangle x1 y1 (fi $ x2 - x1) (fi $ y2 - y1)++-- | Given a bounding rectangle 's' and another rectangle 'r', compute a+-- rectangle 'r' that fits inside 's'.+fitRect :: Rectangle -> Rectangle -> Rectangle+fitRect s r+ = c2r (max sx1 rx1, max sy1 ry1, min sx2 rx2, min sy2 ry2)+ where+    (sx1, sy1, sx2, sy2) = r2c s+    (rx1, ry1, rx2, ry2) = r2c r++-- | Adjust layout automagically.+avoidStruts :: LayoutClass l a => l a -> AvoidStruts l a+avoidStruts = AvoidStruts True++data AvoidStruts l a = AvoidStruts Bool (l a) deriving ( Read, Show )++data ToggleStruts = ToggleStruts deriving (Read,Show,Typeable)+instance Message ToggleStruts++instance LayoutClass l a => LayoutClass (AvoidStruts l) a where+    doLayout (AvoidStruts True lo) r s =+        do rect <- fmap (flip fitRect r) calcGap+           (wrs,mlo') <- doLayout lo rect s+           return (wrs, AvoidStruts True `fmap` mlo')+    doLayout (AvoidStruts False lo) r s = do (wrs,mlo') <- doLayout lo r s+                                             return (wrs, AvoidStruts False `fmap` mlo')+    handleMessage (AvoidStruts b l) m+        | Just ToggleStruts <- fromMessage m = return $ Just $ AvoidStruts (not b) l+        | otherwise = do ml' <- handleMessage l m+                         return (AvoidStruts b `fmap` ml')+    description (AvoidStruts _ l) = description l
+ XMonad/Hooks/SetWMName.hs view
@@ -0,0 +1,112 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.SetWMName+-- Copyright   :  © 2007 Ivan Tarasov <Ivan.Tarasov@gmail.com>+-- License     :  BSD+--+-- Maintainer  :  Ivan.Tarasov@gmail.com+-- Stability   :  experimental+-- Portability :  unportable+--+-- Sets the WM name to a given string, so that it could be detected using+-- _NET_SUPPORTING_WM_CHECK protocol.+--+-- May be useful for making Java GUI programs work, just set WM name to "LG3D"+-- and use Java 1.6u1 (1.6.0_01-ea-b03 works for me) or later.+--+-- Remember that you need to call the setWMName action yourself (at least until+-- we have startup hooks). E.g., you can bind it in your Config.hs:+--+-- > ((modMask x .|. controlMask .|. shiftMask, xK_z), setWMName "LG3D") -- @@ Java hack+--+-- and press the key combination before running the Java programs (you only+-- need to do it once per XMonad execution)+--+-- For details on the problems with running Java GUI programs in non-reparenting+-- WMs, see "http:\/\/bugs.sun.com\/bugdatabase\/view_bug.do?bug_id=6429775" and+-- related bugs.+--+-- Setting WM name to "compiz" does not solve the problem, because of yet+-- another bug in AWT code (related to insets). For LG3D insets are explicitly+-- set to 0, while for other WMs the insets are \"guessed\" and the algorithm+-- fails miserably by guessing absolutely bogus values.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+-----------------------------------------------------------------------------++module XMonad.Hooks.SetWMName (+    setWMName) where++import Control.Monad (join)+import Data.Char (ord)+import Data.List (nub)+import Data.Maybe (fromJust, listToMaybe, maybeToList)+import Foreign.C.Types (CChar)++import Foreign.Marshal.Alloc (alloca)++import XMonad++-- | sets WM name+setWMName :: String -> X ()+setWMName name = do+    atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom+    atom_NET_WM_NAME <- getAtom "_NET_WM_NAME"+    atom_NET_SUPPORTED_ATOM <- getAtom "_NET_SUPPORTED"+    atom_UTF8_STRING <- getAtom "UTF8_STRING"++    root <- asks theRoot+    supportWindow <- getSupportWindow+    dpy <- asks display+    io $ do+        -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window+        mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]+        -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)+        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)+        -- declare which _NET protocols are supported (append to the list if it exists)+        supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root+        changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)+  where+    netSupportingWMCheckAtom :: X Atom+    netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"++    latin1StringToCCharList :: String -> [CChar]+    latin1StringToCCharList str = map (fromIntegral . ord) str++    getSupportWindow :: X Window+    getSupportWindow = withDisplay $ \dpy -> do+        atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom+        root <- asks theRoot+        supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root+        validateWindow (fmap fromIntegral supportWindow)++    validateWindow :: Maybe Window -> X Window+    validateWindow w = do+        valid <- maybe (return False) isValidWindow w+        if valid then+            return $ fromJust w+          else+            createSupportWindow++    -- is there a better way to check the validity of the window?+    isValidWindow :: Window -> X Bool+    isValidWindow w = withDisplay $ \dpy -> io $ alloca $ \p -> do+        status <- xGetWindowAttributes dpy w p+        return (status /= 0)++    -- this code was translated from C (see OpenBox WM, screen.c)+    createSupportWindow :: X Window+    createSupportWindow = withDisplay $ \dpy -> do+        root <- asks theRoot+        let visual = defaultVisual dpy (defaultScreen dpy)  -- should be CopyFromParent (=0), but the constructor is hidden in X11.XLib+        window <- io $ allocaSetWindowAttributes $ \winAttrs -> do+            set_override_redirect winAttrs True         -- WM cannot decorate/move/close this window+            set_event_mask winAttrs propertyChangeMask  -- not sure if this is needed+            let bogusX = -100+                bogusY = -100+              in+                createWindow dpy root bogusX bogusY 1 1 0 0 inputOutput visual (cWEventMask .|. cWOverrideRedirect) winAttrs+        io $ mapWindow dpy window   -- not sure if this is needed+        io $ lowerWindow dpy window -- not sure if this is needed+        return window
+ XMonad/Hooks/UrgencyHook.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.UrgencyHook+-- Copyright   :  Devin Mullins <me@twifkak.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Devin Mullins <me@twifkak.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- UrgencyHook lets you configure an action to occur when a window demands+-- your attention. (In traditional WMs, this takes the form of \"flashing\"+-- on your \"taskbar.\" Blech.)+--+-----------------------------------------------------------------------------++module XMonad.Hooks.UrgencyHook (+                                 -- * Usage+                                 -- $usage+                                 withUrgencyHook,+                                 focusUrgent,+                                 readUrgents, withUrgents,+                                 urgencyLayoutHook,+                                 NoUrgencyHook(..), StdoutUrgencyHook(..),+                                 dzenUrgencyHook, DzenUrgencyHook(..),+                                 UrgencyHook(urgencyHook),+                                 seconds+                                 ) where++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Layout.LayoutModifier hiding (hook)+import XMonad.Util.Dzen (dzenWithArgs, seconds)+import XMonad.Util.NamedWindows (getName)++import Control.Monad (when)+import Data.Bits (testBit, clearBit)+import Data.IORef+import Data.List ((\\), delete)+import Data.Maybe (listToMaybe)+import qualified Data.Set as S+import Foreign (unsafePerformIO)++-- $usage+-- To wire this up, first add:+--+-- > import XMonad.Hooks.UrgencyHook+--+-- to your import list in your config file. Now, choose an urgency hook. If+-- you're just interested in displaying the urgency state in your custom+-- logHook, then choose NoUrgencyHook. Otherwise, you may use the provided+-- 'dzenUrgencyHook', or write your own.+--+-- Enable your urgency hook by wrapping your config record in a call to+-- 'withUrgencyHook'. For example:+--+-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }+-- >               $ defaultConfig+--+-- If you want to modify your logHook to print out information about urgent windows,+-- the functions 'readUrgents' and 'withUrgents' are there to help you with that.+-- No example for you.++-- | This is the preferred method of enabling an urgency hook. It will prepend+-- an action to your logHook that removes visible windows from the list of urgent+-- windows. If you don't like that behavior, you may use 'urgencyLayoutHook' instead.+withUrgencyHook :: (LayoutClass l Window, UrgencyHook h Window) =>+                   h -> XConfig l -> XConfig (ModifiedLayout (WithUrgencyHook h) l)+withUrgencyHook hook conf = conf { layoutHook = urgencyLayoutHook hook $ layoutHook conf+                                 , logHook = removeVisiblesFromUrgents >> logHook conf+                                 }++-- | The logHook action used by 'withUrgencyHook'.+removeVisiblesFromUrgents :: X ()+removeVisiblesFromUrgents = do+    visibles <- gets mapped+    adjustUrgents (\\ (S.toList visibles))++-- | Focuses the most recently urgent window. Good for what ails ya -- I mean, your keybindings.+-- Example keybinding:+--+-- > , ((modMask              , xK_BackSpace), focusUrgent)+focusUrgent :: X ()+focusUrgent = withUrgents $ flip whenJust (windows . W.focusWindow) . listToMaybe++-- | Stores the global set of all urgent windows, across workspaces. Not exported -- use+-- 'readUrgents' or 'withUrgents' instead.+{-# NOINLINE urgents #-}+urgents :: IORef [Window]+urgents = unsafePerformIO (newIORef [])+-- (Hey, I don't like it any more than you do.)++-- | X action that returns a list of currently urgent windows. You might use+-- it, or 'withUrgents', in your custom logHook, to display the workspaces that+-- contain urgent windows.+readUrgents :: X [Window]+readUrgents = io $ readIORef urgents++-- | An HOF version of 'readUrgents', for those who prefer that sort of thing.+withUrgents :: ([Window] -> X a) -> X a+withUrgents f = readUrgents >>= f++data WithUrgencyHook h a = WithUrgencyHook h deriving (Read, Show)++-- The Non-ICCCM Manifesto:+-- Note: Some non-standard choices have been made in this implementation to+-- account for the fact that things are different in a tiling window manager:+--   1. Several clients (e.g. Xchat2, rxvt-unicode) set the urgency flag+--      9 or 10 times in a row. This would, in turn, trigger urgencyHook repeatedly.+--      so in order to prevent that, we immediately clear the urgency flag.+--   2. In normal window managers, windows may overlap, so clients wait for focus to+--      be set before urgency is cleared. In a tiling WM, it's sufficient to be able+--      see the window, since we know that means you can see it completely.+--   3. The urgentOnBell setting in rxvt-unicode sets urgency even when the window+--      has focus, and won't clear until it loses and regains focus. This is stupid.+-- In order to account for these quirks, we clear the urgency bit immediately upon+-- receiving notification (thus suppressing the repeated notifications) and track+-- the list of urgent windows ourselves, allowing us to clear urgency when a window+-- is visible, and not to set urgency if a window is visible.+-- If you have a better idea, please, let us know!+instance UrgencyHook h Window => LayoutModifier (WithUrgencyHook h) Window where+    handleMess (WithUrgencyHook hook) mess+      | Just PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } <- fromMessage mess = do+          when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do+              wmh@WMHints { wmh_flags = flags } <- io $ getWMHints dpy w+              when (testBit flags urgencyHintBit) $ do+                  -- Call the urgencyHook.+                  userCode $ urgencyHook hook w+                  -- Clear the bit to prevent repeated notifications, as described above.+                  io $ setWMHints dpy w wmh { wmh_flags = clearBit flags urgencyHintBit }+                  -- Add to list of urgents.+                  adjustUrgents (\ws -> if elem w ws then ws else w : ws)+                  -- Call logHook after IORef has been modified.+                  userCode =<< asks (logHook . config)+          return Nothing+      | Just DestroyWindowEvent {ev_window = w} <- fromMessage mess = do+          adjustUrgents (delete w)+          return Nothing+      | otherwise =+          return Nothing++adjustUrgents :: ([Window] -> [Window]) -> X ()+adjustUrgents f = io $ modifyIORef urgents f++urgencyLayoutHook :: (UrgencyHook h Window, LayoutClass l Window) =>+                   h -> l Window -> ModifiedLayout (WithUrgencyHook h) l Window+urgencyLayoutHook hook = ModifiedLayout $ WithUrgencyHook hook++--------------------------------------------------------------------------------+-- Urgency Hooks++-- | The class definition, and some pre-defined instances.++class (Read h, Show h) => UrgencyHook h a where+    urgencyHook :: h -> a -> X ()++data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)++instance UrgencyHook NoUrgencyHook Window where+    urgencyHook _ _ = return ()++data DzenUrgencyHook = DzenUrgencyHook { duration :: Int, args :: [String] }+    deriving (Read, Show)++instance UrgencyHook DzenUrgencyHook Window where+    urgencyHook DzenUrgencyHook { duration = d, args = a } w = do+        visibles <- gets mapped+        name <- getName w+        ws <- gets windowset+        whenJust (W.findTag w ws) (flash name visibles)+      where flash name visibles index =+                  when (not $ S.member w visibles) $+                  dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d++-- | Flashes when a window requests your attention and you can't see it. Configurable+-- duration and args to dzen.+dzenUrgencyHook :: DzenUrgencyHook+dzenUrgencyHook = DzenUrgencyHook { duration = (5 `seconds`), args = [] }++-- For debugging purposes, really.+data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)++instance UrgencyHook StdoutUrgencyHook Window where+    urgencyHook    _ w = io $ putStrLn $ "Urgent: " ++ show w
+ XMonad/Hooks/XPropManage.hs view
@@ -0,0 +1,90 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.XPropManage+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>+-- License      : BSD+--+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- A ManageHook matching on XProperties.+-----------------------------------------------------------------------------++module XMonad.Hooks.XPropManage (+                 -- * Usage+                 -- $usage+                 xPropManageHook, XPropMatch, pmX, pmP+                 ) where++import Data.Char (chr)+import Data.List (concat)+import Data.Monoid (mconcat, Endo(..))++import Control.Monad.Trans (lift)++import XMonad+import XMonad.ManageHook ((-->))++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.XPropManage+-- > import qualified XMonad.StackSet as W+-- > import XMonad.Actions.TagWindows+-- > import Data.List+--+-- > manageHook = xPropManageHook xPropMatches +-- >+-- > xPropMatches :: [XPropMatch]+-- > xPropMatches = [ ([ (wM_CLASS, any ("gimp"==))], (\w -> float w >> return (W.shift "2")))+-- >                , ([ (wM_COMMAND, any ("screen" ==)), (wM_CLASS, any ("xterm" ==))], pmX (addTag "screen"))+-- >                , ([ (wM_NAME, any ("Iceweasel" `isInfixOf`))], pmP (W.shift "3"))+-- >                ]+--+-- Properties known to work: wM_CLASS, wM_NAME, wM_COMMAND+--+-- A XPropMatch consists of a list of conditions and function telling what to do.+--+-- The list entries are pairs of an XProperty to match on (like wM_CLASS, wM_NAME)^1,+-- and an function which matches onto the value of the property (represented as a List+-- of Strings).+--+-- If a match succeeds the function is called immediately, can perform any action and then return+-- a function to apply in 'windows' (see Operations.hs). So if the action does only work on the+-- WindowSet use just 'pmP function'.+--+-- \*1 You can get the available properties of an application with the xprop utility. STRING properties+-- should work fine. Others might not work.+--++type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))++pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)+pmX f w = f w >> return id++pmP :: (WindowSet -> WindowSet) -> Window -> X (WindowSet -> WindowSet)+pmP f _ = return f++xPropManageHook :: [XPropMatch] -> ManageHook+xPropManageHook tms = mconcat $ map propToHook tms+    where+      propToHook (ms, f) = fmap and (mapM mkQuery ms) --> mkHook f+      mkQuery (a, tf)    = fmap tf (getQuery a)+      mkHook func        = ask >>= Query . lift . fmap Endo . func ++getProp :: Display -> Window -> Atom -> X ([String])+getProp d w p = do+    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])+    let filt q | q == wM_COMMAND = concat . map splitAtNull+               | otherwise       = id+    return (filt p prop)++getQuery ::  Atom -> Query [String]+getQuery p = ask >>= \w ->  Query . lift $ withDisplay $ \d -> getProp d w p++splitAtNull :: String -> [String]+splitAtNull s = case dropWhile (== (chr 0)) s of+    "" -> []+    s' -> w : splitAtNull s''+          where (w, s'') = break (== (chr 0)) s'
+ XMonad/Layout/Accordion.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Accordion+-- Copyright   :  (c) glasser@mit.edu+-- License     :  BSD+--+-- Maintainer  :  glasser@mit.edu+-- Stability   :  unstable+-- Portability :  unportable+--+-- LayoutClass that puts non-focused windows in ribbons at the top and bottom+-- of the screen.+-----------------------------------------------------------------------------++module XMonad.Layout.Accordion (+    -- * Usage+    -- $usage+    Accordion(Accordion)) where++import XMonad+import qualified XMonad.StackSet as W+import Data.Ratio++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Accordion+--+-- Then edit your @layoutHook@ by adding the Accordion layout:+--+-- > myLayouts = Accordion ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Accordion a = Accordion deriving ( Read, Show )++instance LayoutClass Accordion Window where+    pureLayout _ sc ws = zip ups tops ++ [(W.focus ws, mainPane)] ++ zip dns bottoms+     where+       ups    = W.up ws+       dns    = W.down ws+       (top,  allButTop) = splitVerticallyBy (1%8 :: Ratio Int) sc+       (center,  bottom) = splitVerticallyBy (6%7 :: Ratio Int) allButTop+       (allButBottom, _) = splitVerticallyBy (7%8 :: Ratio Int) sc+       mainPane | ups /= [] && dns /= [] = center+                | ups /= []              = allButTop+                | dns /= []              = allButBottom+                | otherwise              = sc+       tops    = if ups /= [] then splitVertically (length ups) top    else []+       bottoms = if dns /= [] then splitVertically (length dns) bottom else []
+ XMonad/Layout/Circle.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Circle+-- Copyright   :  (c) Peter De Wachter+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Circle is an elliptical, overlapping layout, by Peter De Wachter+--+-----------------------------------------------------------------------------++module XMonad.Layout.Circle (+                             -- * Usage+                             -- $usage+                             Circle (..)+                            ) where -- actually it's an ellipse++import Data.List+import XMonad+import XMonad.StackSet (integrate, peek)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Circle+--+-- Then edit your @layoutHook@ by adding the Circle layout:+--+-- > myLayouts = Circle ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Circle a = Circle deriving ( Read, Show )++instance LayoutClass Circle Window where+    doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s+                             return (layout, Nothing)++circleLayout :: Rectangle -> [a] -> [(a, Rectangle)]+circleLayout _ []     = []+circleLayout r (w:ws) = master : rest+    where master = (w, center r)+          rest   = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..]++raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)]+raiseFocus xs = do focused <- withWindowSet (return . peek)+                   return $ case find ((== focused) . Just . fst) xs of+                              Just x  -> x : delete x xs+                              Nothing -> xs++center :: Rectangle -> Rectangle+center (Rectangle sx sy sw sh) = Rectangle x y w h+    where s = sqrt 2 :: Double+          w = round (fromIntegral sw / s)+          h = round (fromIntegral sh / s)+          x = sx + fromIntegral (sw - w) `div` 2+          y = sy + fromIntegral (sh - h) `div` 2++satellite :: Rectangle -> Double -> Rectangle+satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a))+                                                (sy + round (ry + ry * sin a))+                                                w h+    where rx = fromIntegral (sw - w) / 2+          ry = fromIntegral (sh - h) / 2+          w = sw * 10 `div` 25+          h = sh * 10 `div` 25+
+ XMonad/Layout/Combo.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,+             UndecidableInstances, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Combo+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD-style (see LICENSE)+-- +-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout that combines multiple layouts.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Combo (+                            -- * Usage+                            -- $usage +                            combineTwo,+                            CombineTwo+                           ) where++import Data.List ( delete, intersect, (\\) )+import Data.Maybe ( isJust )+import XMonad hiding (focus)+import XMonad.StackSet ( integrate, Stack(..) )+import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )+import qualified XMonad.StackSet as W ( differentiate )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- +-- > import XMonad.Layout.Combo +-- +-- and add something like+-- +-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)+--+-- to your layouts.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- combineTwo is a new simple layout combinator. It allows the+-- combination of two layouts using a third to split the screen+-- between the two, but has the advantage of allowing you to+-- dynamically adjust the layout, in terms of the number of windows in+-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",+-- and add the following key bindings (or something similar):+--+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".+--+-- These bindings will move a window into the sublayout that is+-- up\/down\/left\/right of its current position.  Note that there is some+-- weirdness in combineTwo, in that the mod-tab focus order is not very closely+-- related to the layout order. This is because we're forced to keep track of+-- the window positions separately, and this is ugly.  If you don't like this,+-- lobby for hierarchical stacks in core xmonad or go reimplement the core of+-- xmonad yourself.++data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a)+                            deriving (Read, Show)++combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>+              super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a+combineTwo = C2 [] []++instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)+    => LayoutClass (CombineTwo (l ()) l1 l2) a where+    doLayout (C2 f w2 super l1 l2) rinput s = arrange (integrate s)+        where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)+                              l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)+                              super' <- maybe super id `fmap`+                                        handleMessage super (SomeMessage ReleaseResources)+                              return ([], Just $ C2 [] [] super' l1' l2')+              arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)+                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)+                               super' <- maybe super id `fmap`+                                         handleMessage super (SomeMessage ReleaseResources)+                               return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')+              arrange origws =+                  do let w2' = case origws `intersect` w2 of [] -> [head origws]+                                                             [x] -> [x]+                                                             x -> case origws \\ x of+                                                                  [] -> init x+                                                                  _ -> x+                         superstack = if focus s `elem` w2'+                                      then Stack { focus=(), up=[], down=[()] }+                                      else Stack { focus=(), up=[], down=[()] }+                         s1 = differentiate f' (origws \\ w2')+                         s2 = differentiate f' w2'+                         f' = focus s:delete (focus s) f+                     ([((),r1),((),r2)], msuper') <- doLayout super rinput superstack+                     (wrs1, ml1') <- runLayout l1 r1 s1+                     (wrs2, ml2') <- runLayout l2 r2 s2+                     return (wrs1++wrs2, Just $ C2 f' w2'+                                     (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))+    handleMessage (C2 f ws2 super l1 l2) m+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `notElem` ws2,+          w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m+                             l2' <- maybe l2 id `fmap` handleMessage l2 m+                             return $ Just $ C2 f (w1:ws2) super l1' l2'+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `elem` ws2,+          w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m+                                l2' <- maybe l2 id `fmap` handleMessage l2 m+                                let ws2' = case delete w1 ws2 of [] -> [w2]+                                                                 x -> x+                                return $ Just $ C2 f ws2' super l1' l2'+        | otherwise = do ml1' <- broadcastPrivate m [l1]+                         ml2' <- broadcastPrivate m [l2]+                         msuper' <- broadcastPrivate m [super]+                         if isJust msuper' || isJust ml1' || isJust ml2'+                            then return $ Just $ C2 f ws2+                                                 (maybe super head msuper')+                                                 (maybe l1 head ml1')+                                                 (maybe l2 head ml2')+                            else return Nothing+    description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "+++                                       description l2 ++" with "++ description super+++differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)+differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z+                                                     , up = reverse $ takeWhile (/=z) xs+                                                     , down = tail $ dropWhile (/=z) xs }+                        | otherwise = differentiate zs xs+differentiate [] xs = W.differentiate xs++broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])+broadcastPrivate a ol = do nml <- mapM f ol+                           if any isJust nml+                              then return $ Just $ zipWith ((flip maybe) id) ol nml+                              else return Nothing+    where f l = handleMessage l a `catchX` return Nothing
+ XMonad/Layout/Dishes.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Dishes+-- Copyright   :  (c) Jeremy Apthorp+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Jeremy Apthorp <nornagon@gmail.com>+-- Stability   :  unstable+-- Portability :  portable+--+-- Dishes is a layout that stacks extra windows underneath the master+-- windows.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Dishes (+                              -- * Usage+                              -- $usage+                              Dishes (..)+                            ) where++import Data.List+import XMonad+import XMonad.StackSet (integrate)+import Control.Monad (ap)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Dishes+--+-- Then edit your @layoutHook@ by adding the Dishes layout:+--+-- > myLayouts = Dishes 2 (1/6) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Dishes a = Dishes Int Rational deriving (Show, Read)+instance LayoutClass Dishes a where+    doLayout (Dishes nmaster h) r =+        return . (\x->(x,Nothing)) .+        ap zip (dishes h r nmaster . length) . integrate+    pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m)+        where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h++dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+dishes h s nmaster n = if n <= nmaster+                        then splitHorizontally n s+                        else ws+ where+    (m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s+    ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest
+ XMonad/Layout/DragPane.hs view
@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DragPane+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>+--                    David Roundy <droundy@darcs.net>,+--                    Andrea Rossato <andrea.rossato@unibz.it>+-- License     :  BSD3-style (see LICENSE)+-- +-- Maintainer  :  David Roundy <droundy@darcs.net>+--                Andrea Rossato <andrea.rossato@unibz.it>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layouts that splits the screen either horizontally or vertically and+-- shows two windows.  The first window is always the master window, and+-- the other is either the currently focused window or the second window in+-- layout order.++-----------------------------------------------------------------------------++module XMonad.Layout.DragPane (+                               -- * Usage+                               -- $usage+                                dragPane+                              , DragPane, DragType (..)+                              ) where++import XMonad+import Data.Unique++import qualified XMonad.StackSet as W +import XMonad.Util.Invisible+import XMonad.Util.XUtils++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.DragPane+--+-- Then edit your @layoutHook@ by adding the DragPane layout:+--+-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++halfHandleWidth :: Integral a => a+halfHandleWidth = 1++handleColor :: String+handleColor = "#000000"++dragPane :: DragType -> Double -> Double -> DragPane a+dragPane t x y = DragPane (I Nothing) t x y++data DragPane a = +    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double +             deriving ( Show, Read )++data DragType = Horizontal | Vertical deriving ( Show, Read )++instance LayoutClass DragPane a where+    doLayout d@(DragPane _ Vertical   _ _) = doLay id d+    doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d+    handleMessage = handleMess++data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )+instance Message SetFrac++handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))+handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x+    | Just e <- fromMessage x :: Maybe Event = do handleEvent d e+                                                  return Nothing+    | Just Hide             <- fromMessage x = do hideWindow win+                                                  return $ Just (DragPane mb ty delta split)+    | Just ReleaseResources <- fromMessage x = do deleteWindow win+                                                  return $ Just (DragPane (I Nothing) ty delta split)+    -- layout specific messages+    | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))+    | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do+                                     return $ Just (DragPane mb ty delta frac)+handleMess _ _ = return Nothing++handleEvent :: DragPane a -> Event -> X ()+handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) +            (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })+    | t == buttonPress && thisw == win || thisbw == win  = do+  mouseDrag (\ex ey -> do+             let frac = case ty of+                        Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)+                        Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)+             sendMessage (SetFrac ident frac))+            (return ())+handleEvent _ _  = return ()++doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))+doLay mirror (DragPane mw ty delta split) r s = do+  let r' = mirror r+      (left', right') = splitHorizontallyBy split r'+      left = case left' of Rectangle x y w h ->+                               mirror $ Rectangle x y (w-halfHandleWidth) h+      right = case right' of+                Rectangle x y w h ->+		    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h+      handr = case left' of+                Rectangle x y w h ->+                    mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h+      wrs = case reverse (W.up s) of+              (master:_) -> [(master,left),(W.focus s,right)]+              [] -> case W.down s of+                      (next:_) -> [(W.focus s,left),(next,right)]+                      [] -> [(W.focus s, r)]+  if length wrs > 1 +     then case mw of+            I (Just (w,_,ident)) -> do +                    w' <- deleteWindow w >> newDragWin handr+                    return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)+            I Nothing -> do +                    w <- newDragWin handr+                    i <- io $ newUnique+                    return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)+     else return (wrs, Nothing)+++newDragWin :: Rectangle -> X Window+newDragWin r = do+  let mask = Just $ exposureMask .|. buttonPressMask+  w <- createNewWindow r mask handleColor+  showWindow  w+  return      w
+ XMonad/Layout/Grid.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Grid+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A simple layout that attempts to put all windows in a square grid.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Grid (+    -- * Usage+    -- $usage+	Grid(..)+) where++import XMonad+import XMonad.StackSet++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Grid+--+-- Then edit your @layoutHook@ by adding the Grid layout:+--+-- > myLayouts = Grid ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Grid a = Grid deriving (Read, Show)++instance LayoutClass Grid a where+    pureLayout Grid r s = arrange r (integrate s)++arrange :: Rectangle -> [a] -> [(a, Rectangle)]+arrange (Rectangle rx ry rw rh) st = zip st rectangles+        where+        nwins = length st+        ncols = ceiling . (sqrt :: Double -> Double) . fromIntegral $ nwins+        mincs = nwins `div` ncols+        extrs = nwins - ncols * mincs+        chop :: Int -> Dimension -> [(Position, Dimension)]+        chop n m = ((0, m - k * fromIntegral (pred n)) :) . map (flip (,) k) . tail . reverse . take n . tail . iterate (subtract k') $ m'+                where+                k :: Dimension+                k = m `div` fromIntegral n+                m' = fromIntegral m+                k' :: Position+                k' = fromIntegral k+        xcoords = chop ncols rw+        ycoords = chop mincs rh+        ycoords' = chop (succ mincs) rh+        (xbase, xext) = splitAt (ncols - extrs) xcoords+        rectangles = combine ycoords xbase ++ combine ycoords' xext+                where+                combine ys xs = [Rectangle (rx + x) (ry + y) w h | (x, w) <- xs, (y, h) <- ys]
+ XMonad/Layout/HintedTile.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.HintedTile+-- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>+--                Andrea Rossato <andrea.rossato@unibz.it>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A gapless tiled layout that attempts to obey window size hints,+-- rather than simply ignoring them.+--+-----------------------------------------------------------------------------++module XMonad.Layout.HintedTile (+                                 -- * Usage+                                 -- $usage+                                 HintedTile(..), Orientation(..)) where++import XMonad hiding (Tall(..))+import qualified XMonad.StackSet as W+import Control.Applicative ((<$>))+import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.HintedTile+--+-- Then edit your @layoutHook@ by adding the HintedTile layout:+--+-- > myLayouts = HintedTile 1 0.1 0.5 Tall ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data HintedTile a = HintedTile+    { nmaster     :: Int+    , delta, frac :: Rational+    , orientation :: Orientation+    } deriving ( Show, Read )++data Orientation = Wide | Tall deriving ( Show, Read )++instance LayoutClass HintedTile Window where+    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f }) r w' = do+        bhs <- mapM getHints w+        let (masters, slaves) = splitAt nm bhs+        return (zip w (tiler masters slaves), Nothing)+     where+        w = W.integrate w'+        tiler masters slaves+            | null masters || null slaves = divide o (masters ++ slaves) r+            | otherwise = split o f r (divide o masters) (divide o slaves)++    pureMessage c m = fmap resize     (fromMessage m) `mplus`+                      fmap incmastern (fromMessage m)+     where+        resize Shrink = c { frac = max 0 $ frac c - delta c }+        resize Expand = c { frac = min 1 $ frac c + delta c }+        incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d }++    description l = show (orientation l)++adjBorder :: Dimension -> Dimension -> D -> D+adjBorder n b (w, h) = (w + n * 2 * b, h + n * 2 * b)++-- | Transform a function on dimensions into one without regard for borders+hintsUnderBorder :: (Dimension, SizeHints) -> D -> D+hintsUnderBorder (bW, h) = adjBorder bW 1 . applySizeHints h . adjBorder bW (-1)++getHints :: Window -> X (Dimension, SizeHints)+getHints w = withDisplay $ \d -> io $ liftM2 (,)+    (fromIntegral . wa_border_width <$> getWindowAttributes d w)+    (getWMNormalHints d w)++-- Divide the screen vertically (horizontally) into n subrectangles+divide :: Orientation -> [(Dimension, SizeHints)] -> Rectangle -> [Rectangle]+divide _ [] _ = []+divide Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :+      (divide Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))+ where (w, h) = hintsUnderBorder bh (sw, sh `div` fromIntegral (1 + (length bhs)))++divide Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :+      (divide Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))+ where+    (w, h) = hintsUnderBorder bh (sw `div` fromIntegral (1 + (length bhs)), sh)++-- Split the screen into two rectangles, using a rational to specify the ratio+split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])+      -> (Rectangle -> [Rectangle]) -> [Rectangle]+split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects+ where+    leftw = floor $ fromIntegral sw * f+    leftRects = left $ Rectangle sx sy leftw sh+    rightx = (maximum . map rect_width) leftRects+    rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh++split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects+ where+    toph = floor $ fromIntegral sh * f+    topRects = top $ Rectangle sx sy sw toph+    bottomy = (maximum . map rect_height) topRects+    bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)
+ XMonad/Layout/LayoutCombinators.hs view
@@ -0,0 +1,216 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.LayoutCombinators+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : David Roundy <droundy@darcs.net>+-- Stability    : unstable+-- Portability  : portable+--+-- A module for combining other layouts.+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutCombinators (+    -- * Usage+    -- $usage++    -- * Combinators using DragPane vertical+    -- $dpv+    (*||*), (**||*),(***||*),(****||*),(***||**),(****||***),+    (***||****),(*||****),(**||***),(*||***),(*||**),++    -- * Combinators using DragPane horizontal+    -- $dph+    (*//*), (**//*),(***//*),(****//*),(***//**),(****//***),+    (***//****),(*//****),(**//***),(*//***),(*//**),++    -- * Combinators using Tall (vertical)+    -- $tv+    (*|*), (**|*),(***|*),(****|*),(***|**),(****|***),+    (***|****),(*|****),(**|***),(*|***),(*|**),++    -- * Combinators using Mirror Tall (horizontal)+    -- $mth+    (*/*), (**/*),(***/*),(****/*),(***/**),(****/***),+    (***/****),(*/****),(**/***),(*/***),(*/**),++    -- * A new combinator+    -- $nc+    (|||),+    JumpToLayout(JumpToLayout)+    ) where++import Data.Maybe ( isJust, isNothing )++import XMonad hiding ((|||))+import XMonad.Layout.Combo+import XMonad.Layout.DragPane++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )+--+-- Then edit your @layoutHook@ by using the new layout combinators:+--+-- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full)  ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**,+         *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**,+         *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** ,+         */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**++-- $dpv+-- These combinators combine two layouts using "XMonad.DragPane" in+-- vertical mode.+(*||*),(**||*),(***||*),(****||*), (***||**),(****||***),+       (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>+          l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a++(*||*)      = combineTwo (dragPane Vertical 0.1 (1/2))+(**||*)     = combineTwo (dragPane Vertical 0.1 (2/3))+(***||*)    = combineTwo (dragPane Vertical 0.1 (3/4))+(****||*)   = combineTwo (dragPane Vertical 0.1 (4/5))+(***||**)   = combineTwo (dragPane Vertical 0.1 (3/5))+(****||***) = combineTwo (dragPane Vertical 0.1 (4/7))+(***||****) = combineTwo (dragPane Vertical 0.1 (3/7))+(*||****)   = combineTwo (dragPane Vertical 0.1 (1/5))+(**||***)   = combineTwo (dragPane Vertical 0.1 (2/5))+(*||***)    = combineTwo (dragPane Vertical 0.1 (1/4))+(*||**)     = combineTwo (dragPane Vertical 0.1 (1/3))++-- $dph+-- These combinators combine two layouts using "XMonad.DragPane" in+-- horizontal mode.+(*//*),(**//*),(***//*),(****//*), (***//**),(****//***),+       (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>+          l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a++(*//*)      = combineTwo (dragPane Horizontal 0.1 (1/2))+(**//*)     = combineTwo (dragPane Horizontal 0.1 (2/3))+(***//*)    = combineTwo (dragPane Horizontal 0.1 (3/4))+(****//*)   = combineTwo (dragPane Horizontal 0.1 (4/5))+(***//**)   = combineTwo (dragPane Horizontal 0.1 (3/5))+(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7))+(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7))+(*//****)   = combineTwo (dragPane Horizontal 0.1 (1/5))+(**//***)   = combineTwo (dragPane Horizontal 0.1 (2/5))+(*//***)    = combineTwo (dragPane Horizontal 0.1 (1/4))+(*//**)     = combineTwo (dragPane Horizontal 0.1 (1/3))++-- $tv+-- These combinators combine two layouts vertically using Tall.+(*|*),(**|*),(***|*),(****|*), (***|**),(****|***),+       (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)+          => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a+(*|*)      = combineTwo (Tall 1 0.1 (1/2))+(**|*)     = combineTwo (Tall 1 0.1 (2/3))+(***|*)    = combineTwo (Tall 1 0.1 (3/4))+(****|*)   = combineTwo (Tall 1 0.1 (4/5))+(***|**)   = combineTwo (Tall 1 0.1 (3/5))+(****|***) = combineTwo (Tall 1 0.1 (4/7))+(***|****) = combineTwo (Tall 1 0.1 (3/7))+(*|****)   = combineTwo (Tall 1 0.1 (1/5))+(**|***)   = combineTwo (Tall 1 0.1 (2/5))+(*|***)    = combineTwo (Tall 1 0.1 (1/4))+(*|**)     = combineTwo (Tall 1 0.1 (1/3))+++-- $mth+-- These combinators combine two layouts horizontally using Mirror+-- Tall (a wide layout).+(*/*),(**/*),(***/*),(****/*), (***/**),(****/***),+       (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)+          => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a+(*/*)      = combineTwo (Mirror $ Tall 1 0.1 (1/2))+(**/*)     = combineTwo (Mirror $ Tall 1 0.1 (2/3))+(***/*)    = combineTwo (Mirror $ Tall 1 0.1 (3/4))+(****/*)   = combineTwo (Mirror $ Tall 1 0.1 (4/5))+(***/**)   = combineTwo (Mirror $ Tall 1 0.1 (3/5))+(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7))+(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7))+(*/****)   = combineTwo (Mirror $ Tall 1 0.1 (1/5))+(**/***)   = combineTwo (Mirror $ Tall 1 0.1 (2/5))+(*/***)    = combineTwo (Mirror $ Tall 1 0.1 (1/4))+(*/**)     = combineTwo (Mirror $ Tall 1 0.1 (1/3))++infixr 5 |||++-- $nc+-- A new layout combinator that allows the use of a prompt to change+-- layout. For more information see "Xmonad.Prompt.Layout"+(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a+(|||) = NewSelect True++data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )++data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable )+instance Message NoWrap++data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable )+instance Message JumpToLayout++instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where+    doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s+                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')+    doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s+                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')+    description (NewSelect True l1 _) = description l1+    description (NewSelect False _ l2) = description l2+    handleMessage l@(NewSelect False _ _) m+        | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m+    handleMessage l@(NewSelect amfirst _ _) m+        | Just NextLayoutNoWrap <- fromMessage m =+                  if amfirst then when' isNothing (passOnM m l) $+                                  fmap Just $ swap l >>= passOn (SomeMessage Wrap)+                             else passOnM m l+    handleMessage l m+        | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $+                                             fmap Just $ swap l >>= passOn (SomeMessage Wrap)+    handleMessage l@(NewSelect True _ l2) m+        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l+    handleMessage l@(NewSelect False l1 _) m+        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l+    handleMessage l m+        | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $+                                                   do ml' <- passOnM m $ sw l+                                                      case ml' of+                                                        Nothing -> return Nothing+                                                        Just l' -> Just `fmap` swap (sw l')+    handleMessage (NewSelect b l1 l2) m+        | Just ReleaseResources  <- fromMessage m =+        do ml1' <- handleMessage l1 m+           ml2' <- handleMessage l2 m+           return $ if isJust ml1' || isJust ml2'+                    then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')+                    else Nothing+    handleMessage l m = passOnM m l++swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)+swap l = sw `fmap` passOn (SomeMessage Hide) l++sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a+sw (NewSelect b lt lf) = NewSelect (not b) lt lf++passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>+          SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)+passOn m l = maybe l id `fmap` passOnM m l++passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>+           SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))+passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m+                                      return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'+passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m+                                       return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'++when' :: Monad m => (a -> Bool) -> m a -> m a -> m a+when' f a b = do a1 <- a; if f a1 then b else return a1+
+ XMonad/Layout/LayoutHints.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.LayoutHints+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : David Roundy <droundy@darcs.net>+-- Stability    : unstable+-- Portability  : portable+--+-- Make layouts respect size hints.+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutHints (+    -- * usage+    -- $usage+    layoutHints,+    LayoutHints) where++import XMonad hiding ( trace )+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.LayoutHints+--+-- Then edit your @layoutHook@ by adding the LayoutHints layout modifier+-- to some layout:+--+-- > myLayouts = layoutHints (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++layoutHints :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHints l a+layoutHints = ModifiedLayout LayoutHints++-- | Expand a size by the given multiple of the border width.  The+-- multiple is most commonly 1 or -1.+adjBorders                :: Dimension -> Dimension -> D -> D+adjBorders bW mult (w,h)  = (w+2*mult*bW, h+2*mult*bW)++data LayoutHints a = LayoutHints deriving (Read, Show)++instance LayoutModifier LayoutHints Window where+    modifierDescription _ = "Hinted"+    redoLayout _ _ _ xs = do+                            bW <- asks (borderWidth . config)+                            xs' <- mapM (applyHint bW) xs+                            return (xs', Nothing)+     where+        applyHint bW (w,Rectangle a b c d) =+            withDisplay $ \disp -> do+                sh <- io $ getWMNormalHints disp w+                let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d)+                return (w, Rectangle a b c' d')
+ XMonad/Layout/LayoutModifier.hs view
@@ -0,0 +1,74 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.LayoutModifier+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : David Roundy <droundy@darcs.net>+-- Stability    : unstable+-- Portability  : portable+--+-- A module for writing easy Llayouts and layout modifiers+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutModifier (+    -- * Usage+    -- $usage+    LayoutModifier(..), ModifiedLayout(..)+    ) where++import XMonad+import XMonad.StackSet ( Stack )++-- $usage+-- Use LayoutModifier to help write easy Layouts.+--+-- LayouModifier defines a class 'LayoutModifier'. Each method as a+-- default implementation.+--+-- For usage examples you can see "XMonad.Layout.WorkspaceDir",+-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder",++class (Show (m a), Read (m a)) => LayoutModifier m a where+    handleMess :: m a -> SomeMessage -> X (Maybe (m a))+    handleMess m mess | Just Hide <- fromMessage mess             = doUnhook+                      | Just ReleaseResources <- fromMessage mess = doUnhook+                      | otherwise = return Nothing+     where doUnhook = do unhook m; return Nothing+    handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))+    handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess+                                          return (Left `fmap` mm')+    redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]+               -> X ([(a, Rectangle)], Maybe (m a))+    redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)+    hook :: m a -> X ()+    hook _ = return ()+    unhook :: m a -> X ()+    unhook _ = return ()+    modifierDescription :: m a -> String+    modifierDescription = const ""++instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where+    doLayout (ModifiedLayout m l) r s =+        do (ws, ml') <- doLayout l r s+           (ws', mm') <- redoLayout m r s ws+           let ml'' = case mm' of+                      Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'+                      Nothing -> ModifiedLayout m `fmap` ml'+           return (ws', ml'')+    handleMessage (ModifiedLayout m l) mess =+        do mm' <- handleMessOrMaybeModifyIt m mess+           ml' <- case mm' of+                  Just (Right mess') -> handleMessage l mess'+                  _ -> handleMessage l mess+           return $ case mm' of+                    Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'+                    _ -> (ModifiedLayout m) `fmap` ml'+    description (ModifiedLayout m l) = modifierDescription m <> description l+     where "" <> x = x+           x <> y = x ++ " " ++ y++data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )
+ XMonad/Layout/LayoutScreens.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.LayoutScreens+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutScreens (+                                    -- * Usage+                                    -- $usage+                                    layoutScreens, fixedLayout+                                   ) where++import XMonad+import qualified XMonad.StackSet as W++-- $usage+-- This module allows you to pretend that you have more than one screen by+-- dividing a single screen into multiple screens that xmonad will treat as+-- separate screens.  This should definitely be useful for testing the+-- behavior of xmonad under Xinerama, and it's possible that it'd also be+-- handy for use as an actual user interface, if you've got a very large+-- screen and long for greater flexibility (e.g. being able to see your+-- email window at all times, a crude mimic of sticky windows).+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Layout.LayoutScreens+--+-- Then add some keybindings; for example:+--+-- >   , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (TwoPane 0.5 0.5))+-- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)+--+-- Another example use would be to handle a scenario where xrandr didn't+-- work properly (e.g. a VNC X server in my case) and you want to be able+-- to resize your screen (e.g. to match the size of a remote VNC client):+--+-- > import XMonad.Layout.LayoutScreens+--+-- >   , ((modMask .|. shiftMask, xK_space),+-- >        layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))+-- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()+layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."+layoutScreens nscr l =+    do rtrect <- asks theRoot >>= getWindowRectangle+       (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] }+       windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->+           let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs+               gaps = map (statusGap . W.screenDetail) $ v:vs+               (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps))+           in  ws { W.current = W.Screen x 0 (SD s g)+                  , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg+                  , W.hidden  = ys }++getWindowRectangle :: Window -> X Rectangle+getWindowRectangle w = withDisplay $ \d ->+    do a <- io $ getWindowAttributes d w+       return $ Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)+                          (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)++data FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)++instance LayoutClass FixedLayout a where+    doLayout (FixedLayout rs) _ s = return (zip (W.integrate s) rs, Nothing)++fixedLayout :: [Rectangle] -> FixedLayout a+fixedLayout = FixedLayout
+ XMonad/Layout/MagicFocus.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.MagicFocus+-- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>+-- License      : BSD+--+-- Maintainer   : Peter De Wachter <pdewacht@gmail.com>+-- Stability    : unstable+-- Portability  : unportable+--+-- Automagically put the focused window in the master area.+-----------------------------------------------------------------------------++module XMonad.Layout.MagicFocus +    (-- * Usage+     -- $usage+     MagicFocus(MagicFocus)+    ) where++import XMonad+import XMonad.StackSet++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.MagicFocus+--+-- Then edit your @layoutHook@ by adding the MagicFocus layout+-- modifier:+--+-- > myLayouts = MagicFocus (Tall 1 (3/100) (1/2)) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data MagicFocus l a = MagicFocus (l a) deriving ( Show , Read )++instance (LayoutClass l Window) => LayoutClass (MagicFocus l) Window where+          doLayout = magicFocus++magicFocus :: LayoutClass l Window => MagicFocus l Window -> Rectangle+           -> Stack Window -> X ([(Window, Rectangle)], Maybe (MagicFocus l Window))+magicFocus (MagicFocus l) r s = +    withWindowSet $ \wset -> do+      (ws,nl) <- doLayout l r (swap s $ peek wset)+      case nl of+        Nothing -> return (ws, Nothing)+        Just l' -> return (ws, Just $ MagicFocus l')++swap :: (Eq a) => Stack a -> Maybe a -> Stack a+swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d)+                           | otherwise         = Stack f u d
+ XMonad/Layout/Magnifier.hs view
@@ -0,0 +1,119 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Magnifier+-- Copyright   :  (c) Peter De Wachter and Andrea Rossato 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- Screenshot  :  <http://caladan.rave.org/magnifier.png>+--+-- This is a layout modifier that will make a layout increase the size+-- of the window that has focus.+--+-----------------------------------------------------------------------------+++module XMonad.Layout.Magnifier+    ( -- * Usage+      -- $usage+      magnifier,+      magnifier',+      MagnifyMsg (..)+    ) where++import XMonad+import XMonad.StackSet+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Magnifier+--+-- Then edit your @layoutHook@ by adding the Magnifier layout modifier+-- to some layout:+--+-- > myLayouts = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- Magnifier supports some commands. To use them add something like+-- this to your key bindings:+--+-- >    , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)+-- >    , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)+-- >    , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Increase the size of the window that has focus+magnifier :: l a -> ModifiedLayout Magnifier l a+magnifier = ModifiedLayout (Mag 1.5 On All)++-- | Increase the size of the window that has focus, unless if it is the+-- master window.+magnifier' :: l a -> ModifiedLayout Magnifier l a+magnifier' = ModifiedLayout (Mag 1.5 On NoMaster)++data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff deriving ( Typeable )+instance Message MagnifyMsg++data Magnifier a = Mag Zoom Toggle MagnifyMaster deriving (Read, Show)++type Zoom = Double++data Toggle        = On  | Off      deriving  (Read, Show)+data MagnifyMaster = All | NoMaster deriving  (Read, Show)++instance LayoutModifier Magnifier Window where+    redoLayout  (Mag z On All     ) = applyMagnifier z+    redoLayout  (Mag z On NoMaster) = unlessMaster $ applyMagnifier z+    redoLayout  _                   = nothing+        where nothing _ _ wrs = return (wrs, Nothing)++    handleMess (Mag z On  t) m+                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z + 0.1) On  t)+                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z - 0.1) On  t)+                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z + 0.1) Off t)+    handleMess (Mag z Off t) m+                    | Just ToggleOn    <- fromMessage m = return . Just $ (Mag z         On  t)+    handleMess _ _ = return Nothing++    modifierDescription (Mag _ On  All     ) = "Magnifier"+    modifierDescription (Mag _ On  NoMaster) = "Magnifier NoMaster"+    modifierDescription (Mag _ Off _       ) = "Magnifier (off)"++type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))++unlessMaster :: NewLayout a -> NewLayout a+unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)+                                              else mainmod r s wrs++applyMagnifier :: Double -> Rectangle -> t -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe a)+applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)+                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify z wr)]+                                                | otherwise         = (w,wr) : ws+                              return (reverse $ foldr mag [] wrs, Nothing)++magnify :: Double -> Rectangle -> Rectangle+magnify zoom (Rectangle x y w h) = Rectangle x' y' w' h'+    where x' = x - fromIntegral (w' - w) `div` 2+          y' = y - fromIntegral (h' - h) `div` 2+          w' = round $ fromIntegral w * zoom+          h' = round $ fromIntegral h * zoom++shrink :: Rectangle -> Rectangle -> Rectangle+shrink (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'+    where x' = max sx x+          y' = max sy y+          w' = min w (fromIntegral sx + sw - fromIntegral x')+          h' = min h (fromIntegral sy + sh - fromIntegral y')
+ XMonad/Layout/Maximize.hs view
@@ -0,0 +1,79 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Maximize+-- Copyright   :  (c) 2007 James Webb+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  xmonad#jwebb,sygneca,com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Temporarily yanks the focused window out of the layout to mostly fill+-- the screen.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Maximize (+        -- * Usage+        -- $usage+        maximize,+        maximizeRestore+    ) where++import XMonad+import XMonad.Layout.LayoutModifier+import Data.List ( partition )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Maximize+--+-- Then edit your @layoutHook@ by adding the Maximize layout modifier:+--+-- > myLayouts = maximize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- In the key-bindings, do something like:+--+-- >        , ((modMask x, xK_backslash), withFocused (sendMessage . maximizeRestore))+-- >        ...+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Maximize a = Maximize (Maybe Window) deriving ( Read, Show )+maximize :: LayoutClass l Window => l Window -> ModifiedLayout Maximize l Window+maximize = ModifiedLayout $ Maximize Nothing++data MaximizeRestore = MaximizeRestore Window deriving ( Typeable, Eq )+instance Message MaximizeRestore+maximizeRestore :: Window -> MaximizeRestore+maximizeRestore = MaximizeRestore++instance LayoutModifier Maximize Window where+    modifierDescription (Maximize _) = "Maximize"+    redoLayout (Maximize mw) rect _ wrs = case mw of+        Just win ->+                return (maxed ++ rest, Nothing)+            where+                maxed = map (\(w, _) -> (w, maxRect)) toMax+                (toMax, rest) = partition (\(w, _) -> w == win) wrs+                maxRect = Rectangle (rect_x rect + 50) (rect_y rect + 50)+                    (rect_width rect - 100) (rect_height rect - 100)+        Nothing -> return (wrs, Nothing)+    handleMess (Maximize mw) m = case fromMessage m of+        Just (MaximizeRestore w) -> case mw of+            Just _ -> return $ Just $ Maximize Nothing+            Nothing -> return $ Just $ Maximize $ Just w+        _ -> return Nothing++-- vim: sw=4:et
+ XMonad/Layout/Mosaic.hs view
@@ -0,0 +1,485 @@+{-# OPTIONS -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonadContrib.Mosaic+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module defines a \"mosaic\" layout, which tries to give each window a+-- user-configurable relative area, while also trying to give them aspect+-- ratios configurable at run-time by the user.+--+-----------------------------------------------------------------------------+module XMonad.Layout.Mosaic (+                             -- * Usage+                             -- $usage+                             mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,+                             tallWindow, wideWindow, flexibleWindow,+                             getName ) where++import Control.Monad.State ( State, put, get, runState )+import System.Random ( StdGen, mkStdGen )+import Data.Maybe ( isJust )++import XMonad hiding ( trace )+import qualified XMonad.StackSet as W+import qualified Data.Map as M+import Data.List ( sort )+import Data.Typeable ( Typeable )+import Control.Monad ( mplus )++import XMonad.Util.NamedWindows+import XMonad.Util.Anneal++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Mosaic+--+-- Then edit your @layoutHook@ by adding the Mosaic layout:+--+-- > myLayouts = mosaic 0.25 0.5 ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- In the key-bindings, do something like:+--+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_h), withFocused (sendMessage . tallWindow))+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_l), withFocused (sendMessage . wideWindow))+-- >   , ((modMask x .|. shiftMask, xK_h     ), withFocused (sendMessage . shrinkWindow))+-- >   , ((modMask x .|. shiftMask, xK_l     ), withFocused (sendMessage . expandWindow))+-- >   , ((modMask x .|. shiftMask, xK_s     ), withFocused (sendMessage . squareWindow))+-- >   , ((modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . myclearWindow))+-- >   , ((controlMask .|. modMask x .|. shiftMask, xK_o     ), withFocused (sendMessage . flexibleWindow))+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data HandleWindow = ExpandWindow Window | ShrinkWindow Window+                  | SquareWindow Window | ClearWindow Window+                  | TallWindow Window | WideWindow Window+                  | FlexibleWindow Window+                    deriving ( Typeable, Eq )++instance Message HandleWindow++expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: Window -> HandleWindow+expandWindow   = ExpandWindow+shrinkWindow   = ShrinkWindow+squareWindow   = SquareWindow+flexibleWindow = FlexibleWindow+myclearWindow  = ClearWindow+tallWindow     = TallWindow+wideWindow     = WideWindow++largeNumber :: Int+largeNumber = 50++defaultArea :: Double+defaultArea = 1++flexibility :: Double+flexibility = 0.1++mosaic :: Double -> Double -> MosaicLayout Window+mosaic d t = Mosaic d t M.empty++data MosaicLayout a = Mosaic Double Double (M.Map Window [WindowHint])+              deriving ( Show, Read )++instance LayoutClass MosaicLayout Window where+    doLayout (Mosaic _ t h) r st = do all_hints <- add_hints (W.integrate st) h+                                      mosaicL t all_hints r (W.integrate st)+        where add_hints [] x = return x+              add_hints (w:ws) x =+                  do z <- withDisplay $ \d -> io $ getWMNormalHints d w+                     let set_asp = case map4 `fmap` sh_aspect z of+                                   Just ((minx,miny),(maxx,maxy))+                                       | or [minx < 1, miny < 1, maxx < 1, maxy < 1] -> id+                                       | minx/miny == maxx/maxy -> set_aspect_ratio (minx/miny) w+                                   _ -> id+                     add_hints ws $ set_MinX z w $ set_MinY z w $ set_MaxX z w $ set_MaxY z w $ set_asp x+              map4 :: Integral a => ((a,a),(a,a)) -> ((Double,Double),(Double,Double))+              map4 ((a,b),(c,d)) = ((fromIntegral a,fromIntegral b),(fromIntegral c,fromIntegral d))++    pureMessage (Mosaic d t h) m = (m1 `fmap` fromMessage m) `mplus` (m2 `fmap` fromMessage m)+        where+          m1 Shrink             = Mosaic d (t/(1+d)) h+          m1 Expand             = Mosaic d (t*(1+d)) h+          m2 (ExpandWindow w)   = Mosaic d t (multiply_area (1+d) w h)+          m2 (ShrinkWindow w)   = Mosaic d t (multiply_area (1/(1+ d)) w h)+          m2 (SquareWindow w)   = Mosaic d t (set_aspect_ratio 1 w h)+          m2 (FlexibleWindow w) = Mosaic d t (make_flexible w h)+          m2 (TallWindow w)     = Mosaic d t (multiply_aspect (1/(1+d)) w h)+          m2 (WideWindow w)     = Mosaic d t (multiply_aspect (1+d) w h)+          m2 (ClearWindow w)    = Mosaic d t (M.delete w h)++    description _ = "mosaic"++multiply_area :: Double -> Window+              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)]+                                    f (RelArea a':xs) = RelArea (a'*a) : xs+                                    f (x:xs) = x : f xs++set_aspect_ratio :: Double -> Window+                 -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+set_aspect_ratio r = alterlist f where f [] = [AspectRatio r]+                                       f (FlexibleAspectRatio _:x) = AspectRatio r:x+                                       f (AspectRatio _:x) = AspectRatio r:x+                                       f (x:xs) = x:f xs++make_flexible :: Window+              -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r+                                        f (FlexibleAspectRatio r) = AspectRatio r+                                        f x = x++multiply_aspect :: Double -> Window+                -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r]+                                      f (AspectRatio r':x) = AspectRatio (r*r'):x+                                      f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x+                                      f (x:xs) = x:f xs++set_MaxX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+set_MaxX h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxX) (MaxX $ fromIntegral mx)+           | otherwise = const id++set_MaxY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+set_MaxY h | Just (_,mx) <- sh_max_size h = replaceinmap (isJust . isMaxY) (MaxY $ fromIntegral mx)+           | otherwise = const id++isMaxX,isMaxY :: WindowHint -> Maybe Dimension+isMaxX (MaxX x) = Just x+isMaxX _ = Nothing+isMaxY (MaxY x) = Just x+isMaxY _ = Nothing++set_MinX :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+set_MinX h | Just (mx,_) <- sh_min_size h = replaceinmap isMinX (MinX $ fromIntegral mx)+           | otherwise = const id+    where isMinX (MinX _) = True+          isMinX _ = False++set_MinY :: SizeHints -> Window -> M.Map Window [WindowHint] -> M.Map Window [WindowHint]+set_MinY h | Just (_,mx) <- sh_min_size h = replaceinmap isMinY (MinY $ fromIntegral mx)+           | otherwise = const id+    where isMinY (MinY _) = True+          isMinY _ = False++replaceinmap :: Ord a => (a -> Bool) -> a -> Window -> M.Map Window [a] -> M.Map Window [a]+replaceinmap repl v = alterlist f where f [] = [v]+                                        f (x:xs) | repl x = v:xs+                                                 | otherwise = x:f xs++findlist :: Window -> M.Map Window [a] -> [a]+findlist = M.findWithDefault []++alterlist :: (Ord a) => ([a] -> [a]) -> Window -> M.Map Window [a] -> M.Map Window [a]+alterlist f k = M.alter f' k+    where f' Nothing = f' (Just [])+          f' (Just xs) = case f xs of+                           [] -> Nothing+                           xs' -> Just xs'++mosaicL :: Double -> M.Map Window [WindowHint]+        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (MosaicLayout Window))+mosaicL _ _ _ [] = return ([], Nothing)+mosaicL f hints origRect origws+    = do let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) origws+             -- TODO: remove all this dead code+             myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws+             myv2 = mc_mosaic sortedws Vertical+             myh2 = mc_mosaic sortedws Horizontal+--             myv2 = maxL $ runCountDown largeNumber $+--                    sequence $ replicate mediumNumber $+--                    mosaic_splits one_split origRect Vertical sortedws+             myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws+--             myh2 = maxL $ runCountDown largeNumber $+--                    sequence $ replicate mediumNumber $+--                    mosaic_splits one_split origRect Horizontal sortedws+         return (map (\(w,r)->(--trace ("rate1:"++ unlines [show nw,+                                 --                           show $ rate f meanarea (findlist nw hints) r,+                                 --                           show r,+                                 --                           show $ area r/meanarea,+                                 --                           show $ findlist nw hints]) $+                                 w,crop' (findlist w hints) r)) $+                flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)+    where mosaic_splits _ _ _ [] = return $ Rated 0 $ M []+          mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r)+          mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws)+          even_split :: Rectangle -> CutDirection -> [[Window]]+                     -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))+          even_split r d [ws] = even_split r d $ map (:[]) ws+          even_split r d wss =+              do let areas = map sumareas wss+                     maxds = map (maxd d) wss+                 let wsr_s :: [([Window], Rectangle)]+                     wsr_s = zip wss (partitionR d r maxds areas)+                 submosaics <- mapM (\(ws',r') ->+                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s+                 return $ fmap M $ catRated submosaics+          {-+          another_mosaic :: [Window] -> CutDirection+                         -> Rated Double (Mosaic (Window,Rectangle))+          another_mosaic ws d = rate_mosaic ratew $+                                rect_mosaic origRect d $+                                zipML (example_mosaic ws) (map findarea ws)+          -}+          mc_mosaic :: [Window] -> CutDirection+                    -> Rated Double (Mosaic (Window,Rectangle))+          mc_mosaic ws d = fmap (rect_mosaic origRect d) $+                           annealMax (zipML (example_mosaic ws) (map findarea ws))+                           (the_rating . rate_mosaic ratew . rect_mosaic origRect d )+                           changeMosaic++          ratew :: (Window,Rectangle) -> Double+          ratew (w,r) = rate f meanarea (findlist w hints) r+          example_mosaic :: [Window] -> Mosaic Window+          example_mosaic ws = M (map OM ws)+          rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle)+          rect_mosaic r _ (OM (w,_)) = OM (w,r)+          rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs+              where areas = map (sum . map snd . flattenMosaic) ws+                    maxds = repeat 1+                    rs = partitionR d r maxds areas+                    d' = otherDirection d+          rate_mosaic :: ((Window,Rectangle) -> Double)+                      -> Mosaic (Window,Rectangle) -> Rated Double (Mosaic (Window,Rectangle))+          rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m+{-+          one_split :: Rectangle -> CutDirection -> [[Window]]+                    -> State CountDown (Rated Double (Mosaic (Window, Rectangle)))+          one_split r d [ws] = one_split r d $ map (:[]) ws+          one_split r d wss =+              do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss]+                 let wsr_s :: [([Window], Rectangle)]+                     wsr_s = zip wss (partitionR d r rnd)+                 submosaics <- mapM (\(ws',r') ->+                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s+                 return $ fmap M $ catRated submosaics+-}+          partitionR :: CutDirection -> Rectangle -> [Dimension] -> [Double] -> [Rectangle]+          partitionR _ _ _ [] = []+          partitionR _ _ [] _ = []+          partitionR _ r _ [_] = [r]+          partitionR d r (m:ms) (a:ars) = r1 : partitionR d r2 ms ars+              where totarea = sum (a:ars)+                    totd = fromIntegral $ dimR d r+                    (r1,r2) = if a/totarea > fromIntegral m / totd+                              then if a/totarea > 1 - fromIntegral (sum ms) / totd+                                   then split d (1 - fromIntegral (sum ms) / totd) r+                                   else split d (a/totarea) r+                              else split d (fromIntegral m / totd) r+          theareas = hints2area `fmap` hints+          sumareas ws = sum $ map findarea ws+          maxd Vertical ws = maximum $ map (findhinted isMaxY 3) ws+          maxd Horizontal ws = maximum $ map (findhinted isMaxX 3) ws+          findarea :: Window -> Double+          findarea w = M.findWithDefault 1 w theareas+          findhinted fh d w = fh' $ M.findWithDefault [] w hints+              where fh' [] = d+                    fh' (h:hs) | Just x <- fh h = x+                               | otherwise = fh' hs+          meanarea =  area origRect / fromIntegral (length origws)++dimR :: CutDirection -> Rectangle -> Dimension+dimR Vertical (Rectangle _ _ _ h) = h+dimR Horizontal (Rectangle _ _ w _) = w++maxL :: Ord a => [a] -> a+maxL [] = error "maxL on empty list"+maxL [a] = a+maxL (a:b:c) = maxL (max a b:c)++catRated :: Floating v => [Rated v a] -> Rated v [a]+catRated xs = Rated (product $ map the_rating xs) (map the_value xs)++catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a)+catRatedM (OM (Rated v x)) =  Rated v (OM x)+catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs')++data CountDown = CD !StdGen !Int++tries_left :: State CountDown Int+tries_left = do CD _ n <- get+                return (max 0 n)++mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b]+mapCD f xs = do n <- tries_left+                let len = length xs+                mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs++run_with_only :: Int -> State CountDown a -> State CountDown a+run_with_only limit j =+    do CD g n <- get+       let leftover = n - limit+       if leftover < 0 then j+                       else do put $ CD g limit+                               x <- j+                               CD g' n' <- get+                               put $ CD g' (leftover + n')+                               return x++data WindowHint = RelArea Double+                | MaxX Dimension+                | MaxY Dimension+                | MinX Dimension+                | MinY Dimension+                | AspectRatio Double+                | FlexibleAspectRatio Double+                  deriving ( Show, Read, Eq, Ord )++fixedAspect :: [WindowHint] -> Bool+fixedAspect [] = False+fixedAspect (AspectRatio _:_) = True+fixedAspect (_:x) = fixedAspect x++rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double+rate defaulta meanarea xs rr+    | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight+    | otherwise = (area rr / meanarea)**(weight-flexibility)+                  * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility+     where weight = hints2area xs++crop1 :: WindowHint -> Rectangle -> Rectangle+crop1 (FlexibleAspectRatio f) r = cropit f r+crop1 h r = crop1' h r++crop1' :: WindowHint -> Rectangle -> Rectangle+crop1' (AspectRatio f) r = cropit f r+crop1' (FlexibleAspectRatio f) r = cropit f r+crop1' (MaxX xm) (Rectangle x y w h) | w > xm = Rectangle x y xm h+                                     | otherwise = Rectangle x y w h+crop1' (MaxY xm) (Rectangle x y w h) | h > xm = Rectangle x y w xm+                                     | otherwise = Rectangle x y w h+crop1' _ r = r++crop :: [WindowHint] -> Rectangle -> Rectangle+crop (h:hs) = crop hs . crop1 h+crop [] = id++crop' :: [WindowHint] -> Rectangle -> Rectangle+crop' (h:hs) = crop' hs . crop1' h+crop' [] = id++cropit :: Double -> Rectangle -> Rectangle+cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h+                             | otherwise = Rectangle a b w (ceiling $ w -/ f)++hints2area :: [WindowHint] -> Double+hints2area [] = defaultArea+hints2area (RelArea r:_) = r+hints2area (_:x) = hints2area x++area :: Rectangle -> Double+area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h++(-/-) :: (Integral a, Integral b) => a -> b -> Double+a -/- b = fromIntegral a / fromIntegral b++(-/) :: (Integral a) => a -> Double -> Double+a -/ b = fromIntegral a / b++(-*) :: (Integral a) => a -> Double -> Double+a -* b = fromIntegral a * b++split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle)+split d frac r | frac <= 0 || frac >= 1 = split d 0.5 r+split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h,+                                               Rectangle sx (sy+fromIntegral h) sw (sh-h))+    where h = floor $ fromIntegral sh * frac+split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh,+                                                 Rectangle (sx+fromIntegral w) sy (sw-w) sh)+    where w = floor $ fromIntegral sw * frac++data CutDirection = Vertical | Horizontal+otherDirection :: CutDirection -> CutDirection+otherDirection Vertical = Horizontal+otherDirection Horizontal = Vertical++data Mosaic a = M [Mosaic a] | OM a+          deriving ( Show )++instance Functor Mosaic where+    fmap f (OM x) = OM (f x)+    fmap f (M xs) = M (map (fmap f) xs)++zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c+zipMLwith f (OM x) (y:_) = OM (f x y)+zipMLwith _ (OM _) [] = error "bad zipMLwith"+zipMLwith f (M xxs) yys = makeM $ foo xxs yys+    where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) :+                          foo xs (drop (lengthM x) ys)+          foo [] _ = []++zipML :: Mosaic a -> [b] -> Mosaic (a,b)+zipML = zipMLwith (\a b -> (a,b))++lengthM :: Mosaic a -> Int+lengthM (OM _) = 1+lengthM (M x) = sum $ map lengthM x++changeMosaic :: Mosaic a -> [Mosaic a]+changeMosaic (OM _) = []+changeMosaic (M xs) = map makeM (concatenations xs) +++                      map makeM (splits xs) +++                      map M (tryAll changeMosaic xs)++tryAll :: (a -> [a]) -> [a] -> [[a]]+tryAll _ [] = []+tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs)++splits :: [Mosaic a] -> [[Mosaic a]]+splits [] = []+splits (OM x:y) = map (OM x:) $ splits y+splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z)+splits (M []:x) = splits x++concatenations :: [Mosaic a] -> [[Mosaic a]]+concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z))+concatenations _ = []++concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a+concatenateMosaic (OM a) (OM b) = M [OM a, OM b]+concatenateMosaic (OM a) (M b) = M (OM a:b)+concatenateMosaic (M a) (OM b) = M (a++[OM b])+concatenateMosaic (M a) (M b) = M (a++b)++makeM :: [Mosaic a] -> Mosaic a+makeM [m] = m+makeM [] = error "makeM []"+makeM ms = M ms++flattenMosaic :: Mosaic a -> [a]+flattenMosaic (OM a) = [a]+flattenMosaic (M xs) = concatMap flattenMosaic xs++allsplits :: [a] -> [[[a]]]+allsplits [] = [[[]]]+allsplits [a] = [[[a]]]+allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest)+    where splitsrest = allsplits' xs++allsplits' :: [a] -> [[[a]]]+allsplits' [] = [[[]]]+allsplits' [a] = [[[a]]]+allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest)+    where splitsrest = allsplits xs++maphead :: (a->a) -> [a] -> [a]+maphead f (x:xs) = f x : xs+maphead _ [] = []++runCountDown :: Int -> State CountDown a -> a+runCountDown n x = fst $ runState x (CD (mkStdGen n) n)
+ XMonad/Layout/MosaicAlt.hs view
@@ -0,0 +1,168 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MosaicAlt+-- Copyright   :  (c) 2007 James Webb+-- License     :  BSD-style (see xmonad/LICENSE)+-- +-- Maintainer  :  xmonad#jwebb,sygneca,com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout which gives each window a specified amount of screen space +-- relative to the others. Compared to the 'Mosaic' layout, this one+-- divides the space in a more balanced way.+--+-----------------------------------------------------------------------------++module XMonad.Layout.MosaicAlt (+        -- * Usage:+        -- $usage+        MosaicAlt(..)+        , shrinkWindowAlt+        , expandWindowAlt+        , tallWindowAlt+        , wideWindowAlt+        , resetAlt+    ) where++import XMonad+import qualified XMonad.StackSet as W+import qualified Data.Map as M+import Data.List ( sortBy )+import Data.Ratio++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.MosaicAlt+-- > import qualified Data.Map as M+--+-- Then edit your @layoutHook@ by adding the MosaicAlt layout:+--+-- > myLayouts = MosaicAlt M.empty ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- In the key-bindings, do something like:+--+-- >     , ((modMask x .|. shiftMask  , xK_a    ), withFocused (sendMessage . expandWindowAlt))+-- >     , ((modMask x .|. shiftMask  , xK_z    ), withFocused (sendMessage . shrinkWindowAlt))+-- >     , ((modMask x .|. shiftMask  , xK_s    ), withFocused (sendMessage . tallWindowAlt))+-- >     , ((modMask x .|. shiftMask  , xK_d    ), withFocused (sendMessage . wideWindowAlt))+-- >     , ((modMask x .|. controlMask, xK_space), sendMessage resetAlt)+-- >     ...+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data HandleWindowAlt =+    ShrinkWindowAlt Window+    | ExpandWindowAlt Window+    | TallWindowAlt Window+    | WideWindowAlt Window+    | ResetAlt+    deriving ( Typeable, Eq )+instance Message HandleWindowAlt+shrinkWindowAlt, expandWindowAlt :: Window -> HandleWindowAlt+tallWindowAlt, wideWindowAlt :: Window -> HandleWindowAlt+shrinkWindowAlt = ShrinkWindowAlt+expandWindowAlt = ExpandWindowAlt+tallWindowAlt = TallWindowAlt+wideWindowAlt = WideWindowAlt+resetAlt :: HandleWindowAlt+resetAlt = ResetAlt++data Param = Param { area, aspect :: Rational } deriving ( Show, Read )+type Params = M.Map Window Param+data MosaicAlt a = MosaicAlt Params deriving ( Show, Read )++instance LayoutClass MosaicAlt Window where+    description _ = "MosaicAlt"+    doLayout (MosaicAlt params) rect stack =+            return (arrange rect stack params', Just $ MosaicAlt params')+        where+            params' = ins (W.up stack) $ ins (W.down stack) $ ins [W.focus stack] params+            ins wins as = foldl M.union as $ map (`M.singleton` (Param 1 1.5)) wins++    handleMessage (MosaicAlt params) msg = return $ case fromMessage msg of+        Just (ShrinkWindowAlt w) -> Just $ MosaicAlt $ alter params w (4 % 5) 1+        Just (ExpandWindowAlt w) -> Just $ MosaicAlt $ alter params w (6 % 5) 1+        Just (TallWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (3 % 4)+        Just (WideWindowAlt w) -> Just $ MosaicAlt $ alter params w 1 (5 % 4)+        Just ResetAlt -> Just $ MosaicAlt M.empty+        _ -> Nothing++-- Change requested params for a window.+alter :: Params -> Window -> Rational -> Rational -> Params+alter params win arDelta asDelta = case M.lookup win params of+    Just (Param ar as) -> M.insert win (Param (ar * arDelta) (as * asDelta)) params+    Nothing -> M.insert win (Param arDelta (1.5 * asDelta)) params++-- Layout algorithm entry point.+arrange :: Rectangle -> W.Stack Window -> Params -> [(Window, Rectangle)]+arrange rect stack params = r+    where+        (_, r) = findSplits 3 rect tree params+        tree = makeTree (sortBy areaCompare wins) params+        wins = reverse (W.up stack) ++ W.focus stack : W.down stack+        areaCompare a b = or1 b `compare` or1 a+        or1 w = maybe 1 area $ M.lookup w params++-- Recursively group windows into a binary tree. Aim to balance the tree+-- according to the total requested area in each branch.+data Tree = Node (Rational, Tree) (Rational, Tree) | Leaf Window | None+makeTree :: [Window] -> Params -> Tree+makeTree wins params = case wins of+    [] -> None+    [x] -> Leaf x+    _ -> Node (aArea, makeTree aWins params) (bArea, makeTree bWins params)+        where ((aWins, aArea), (bWins, bArea)) = areaSplit params wins++-- Split a list of windows in half by area.+areaSplit :: Params -> [Window] -> (([Window], Rational), ([Window], Rational))+areaSplit params wins = gather [] 0 [] 0 wins+    where+        gather a aa b ba (r : rs) =+            if aa <= ba+                then gather (r : a) (aa + or1 r) b ba rs+                else gather a aa (r : b) (ba + or1 r) rs+        gather a aa b ba [] = ((reverse a, aa), (b, ba))+        or1 w = maybe 1 area $ M.lookup w params++-- Figure out which ways to split the space, by exhaustive search.+-- Complexity is quadratic in the number of windows.+findSplits :: Int -> Rectangle -> Tree -> Params -> (Double, [(Window, Rectangle)])+findSplits _ _ None _ = (0, [])+findSplits _ rect (Leaf w) params = (aspectBadness rect w params, [(w, rect)])+findSplits depth rect (Node (aArea, aTree) (bArea, bTree)) params =+        if hBadness < vBadness then (hBadness, hList) else (vBadness, vList)+    where+        (hBadness, hList) = trySplit splitHorizontallyBy+        (vBadness, vList) = trySplit splitVerticallyBy+        trySplit splitBy =+                (aBadness + bBadness, aList ++ bList)+            where+                (aBadness, aList) = findSplits (depth - 1) aRect aTree params+                (bBadness, bList) = findSplits (depth - 1) bRect bTree params+                (aRect, bRect) = splitBy ratio rect+        ratio = aArea / (aArea + bArea)++-- Decide how much we like this rectangle.+aspectBadness :: Rectangle -> Window -> Params -> Double+aspectBadness rect win params =+        (if a < 1 then tall else wide) * sqrt(w * h)+    where+        tall = if w < 700 then ((1 / a) * (700 / w)) else 1 / a+        wide = if w < 700 then a else (a * w / 700)+        a = (w / h) / fromRational (maybe 1.5 aspect $ M.lookup win params)+        w = fromIntegral $ rect_width rect+        h = fromIntegral $ rect_height rect++-- vim: sw=4:et
+ XMonad/Layout/MultiToggle.hs view
@@ -0,0 +1,230 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MultiToggle+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Dynamically apply and unapply transformers to your window layout. This can+-- be used to rotate your window layout by 90 degrees, or to make the+-- currently focused window occupy the whole screen (\"zoom in\") then undo+-- the transformation (\"zoom out\").+++module XMonad.Layout.MultiToggle (+    -- * Usage+    -- $usage+    Transformer(..),+    Toggle(..),+    (??),+    EOT(..),+    mkToggle+) where++import XMonad++import Control.Arrow+import Data.Typeable+import Data.Maybe++-- $usage+-- The basic idea is to have a base layout and a set of layout transformers,+-- of which at most one is active at any time. Enabling another transformer+-- first disables any currently active transformer; i.e. it works like a+-- group of radio buttons.+--+-- A side effect of this meta-layout is that layout transformers no longer+-- receive any messages; any message not handled by SwitchTrans itself will+-- undo the current layout transformer, pass the message on to the base+-- layout, then reapply the transformer.+--+-- To use this module, you first have to define the transformers that you+-- want to be handled by @MultiToggle@. For example, if the transformer is+-- 'XMonad.Layout.Mirror':+--+-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)+-- > instance Transformer MIRROR Window where+-- >     transform _ x k = k (Mirror x)+--+-- @MIRROR@ can be any identifier (it has to start with an uppercase letter,+-- of course); I've chosen an all-uppercase version of the transforming+-- function's name here. You need to put @{-\# OPTIONS_GHC -fglasgow-exts \#-}@+-- at the beginning of your file to be able to derive "Data.Typeable".+--+-- Somewhere else in your file you probably have a definition of @layout@;+-- the default looks like this:+--+-- > layout = tiled ||| Mirror tiled ||| Full+--+-- After changing this to+--+-- > layout = mkToggle (MIRROR ?? EOT) (tiled ||| Full)+--+-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation:+--+-- > ...+-- >   , ((modMask,               xK_x     ), sendMessage $ Toggle MIRROR)+-- > ...+--+-- (That should be part of your key bindings.) When you press @mod-x@, the+-- active layout is mirrored. Another @mod-x@ and it's back to normal.+--+-- It's also possible to stack @MultiToggle@s. Let's define a few more+-- transformers ('XMonad.Layout.NoBorders.noBorders' is in+-- "XMonad.Layout.NoBorders"):+--+-- > data NOBORDERS = NOBORDERS deriving (Read, Show, Eq, Typeable)+-- > instance Transformer NOBORDERS Window where+-- >     transform _ x k = k (noBorders x)+-- > +-- > data FULL = FULL deriving (Read, Show, Eq, Typeable)+-- > instance Transformer FULL Window where+-- >     transform _ x k = k Full+--+-- @+-- layout = id+--     . 'XMonad.Layout.NoBorders.smartBorders'+--     . mkToggle (NOBORDERS ?? FULL ?? EOT)+--     . mkToggle (MIRROR ?? EOT)+--     $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle'+-- @+--+-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily+-- maximize windows, in addition to being able to rotate layouts and remove+-- window borders.++-- | A class to identify custom transformers (and look up transforming+-- functions by type).+class (Eq t, Typeable t) => Transformer t a | t -> a where+    transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b++data EL a = forall l. (LayoutClass l a) => EL (l a)++unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b+unEL (EL x) k = k x++transform' :: (Transformer t a) => t -> EL a -> EL a+transform' t el = el `unEL` \l -> transform t l EL++-- | Toggle the specified layout transformer.+data Toggle a = forall t. (Transformer t a) => Toggle t+    deriving (Typeable)++instance (Typeable a) => Message (Toggle a)++data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts+    deriving (Read, Show)++data MultiToggle ts l a = MultiToggle{+    baseLayout :: l a,+    currLayout :: EL a,+    currIndex :: Maybe Int,+    currTrans :: EL a -> EL a,+    transformers :: ts+}++expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts l a+expand (MultiToggleS b i ts) =+    resolve ts (fromMaybe (-1) i) id+        (\x mt ->+            let g = transform' x in+            mt{+                currLayout = g . EL $ baseLayout mt,+                currTrans = g+            }+        )+        (MultiToggle b (EL b) i id ts)++collapse :: MultiToggle ts l a -> MultiToggleS ts l a+collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt)++instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where+    readsPrec p s = map (first expand) $ readsPrec p s++instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where+    showsPrec p = showsPrec p . collapse++-- | Construct a @MultiToggle@ layout from a transformer table and a base+-- layout.+mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a+mkToggle ts l = MultiToggle l (EL l) Nothing id ts++-- | Marks the end of a transformer list.+data EOT = EOT deriving (Read, Show)+data HCons a b = HCons a b deriving (Read, Show)++infixr 0 ??+-- | Prepend an element to a heterogeneous list. Used to build transformer+-- tables for 'mkToggle'.+(??) :: (HList b w) => a -> b -> HCons a b+(??) = HCons++class HList c a where+    find :: (Transformer t a) => c -> t -> Maybe Int+    resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b++instance HList EOT w where+    find EOT _ = Nothing+    resolve EOT _ d _ = d++instance (Transformer a w, HList b w) => HList (HCons a b) w where+    find (HCons x xs) t+        | t `geq` x = Just 0+        | otherwise = fmap succ (find xs t)+    resolve (HCons x xs) n d k =+        case n `compare` 0 of+            LT -> d+            EQ -> k x+            GT -> resolve xs (pred n) d k++geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool+geq a b = Just a == cast b++acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c+acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x }))++instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where+    description _ = "MultiToggle"++    pureLayout mt r s = currLayout mt `unEL` \l -> pureLayout l r s++    doLayout mt r s = currLayout mt `unEL` \l -> acceptChange mt (fmap . fmap) (doLayout l r s)++    handleMessage mt m+        | Just (Toggle t) <- fromMessage m+        , i@(Just _) <- find (transformers mt) t+            = currLayout mt `unEL` \l ->+            if i == currIndex mt+                then do+                    handleMessage l (SomeMessage ReleaseResources)+                    return . Just $+                        mt{+                            currLayout = EL $ baseLayout mt,+                            currIndex = Nothing,+                            currTrans = id+                        }+                else do+                    handleMessage l (SomeMessage ReleaseResources)+                    let f = transform' t+                    return . Just $+                        mt{+                            currLayout = f . EL $ baseLayout mt,+                            currIndex = i,+                            currTrans = f+                        }+        | fromMessage m == Just ReleaseResources ||+          fromMessage m == Just Hide+            = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m)+        | otherwise = do+            ml <- handleMessage (baseLayout mt) m+            case ml of+                Nothing -> return Nothing+                Just b' -> currLayout mt `unEL` \l -> do+                    handleMessage l (SomeMessage ReleaseResources)+                    return . Just $+                        mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' }
+ XMonad/Layout/Named.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Named+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for assigning a name to a given layout.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Named (+                                -- * Usage+                                -- $usage+                                Named(Named)+                               ) where++import XMonad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Named+--+-- Then edit your @layoutHook@ by adding the Named layout modifier+-- to some layout:+--+-- > myLayouts = Named "real big" Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Named l a = Named String (l a) deriving ( Read, Show )++instance (LayoutClass l a) => LayoutClass (Named l) a where+    doLayout (Named n l) r s = do (ws, ml') <- doLayout l r s+                                  return (ws, Named n `fmap` ml')+    handleMessage (Named n l) mess = do ml' <- handleMessage l mess+                                        return $ Named n `fmap` ml'+    description (Named n _) = n
+ XMonad/Layout/NoBorders.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.NoBorders+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Make a given layout display without borders.  This is useful for+-- full-screen or tabbed layouts, where you don't really want to waste a+-- couple of pixels of real estate just to inform yourself that the visible+-- window has focus.+--+-----------------------------------------------------------------------------++module XMonad.Layout.NoBorders (+                                -- * Usage+                                -- $usage+                                noBorders,+                                smartBorders,+                                withBorder+                               ) where++import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.StackSet as W+import Data.List ((\\))++-- $usage+-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Layout.NoBorders+--+-- and modify the layouts to call noBorders on the layouts you want to lack+-- borders:+--+-- > layoutHook = ... ||| noBorders Full ||| ...+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- todo, use an InvisibleList.+data WithBorder a = WithBorder Dimension [a] deriving ( Read, Show )++instance LayoutModifier WithBorder Window where+    unhook (WithBorder _ s) = asks (borderWidth . config) >>= setBorders s++    redoLayout (WithBorder n s) _ _ wrs = do+        asks (borderWidth . config) >>= setBorders (s \\ ws)+        setBorders ws n+        return (wrs, Just $ WithBorder n ws)+     where+        ws = map fst wrs++noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window+noBorders = ModifiedLayout $ WithBorder 0 []++withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a+withBorder b = ModifiedLayout $ WithBorder b []++setBorders :: [Window] -> Dimension -> X ()+setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws++data SmartBorder a = SmartBorder [a] deriving (Read, Show)++instance LayoutModifier SmartBorder Window where+    unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s++    redoLayout (SmartBorder s) _ _ wrs = do+        ss <- gets (W.screens . windowset)++        if singleton ws && singleton ss+            then do+                asks (borderWidth . config) >>= setBorders (s \\ ws)+                setBorders ws 0+                return (wrs, Just $ SmartBorder ws)+            else do+                asks (borderWidth . config) >>= setBorders s+                return (wrs, Just $ SmartBorder [])+     where+        ws = map fst wrs+        singleton = null . drop 1++--+-- | You can cleverly set no borders on a range of layouts, using a+-- layoutHook like so:+--+-- > layoutHook = smartBorders $ tiled ||| Mirror tiled ||| ...+--+smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a+smartBorders = ModifiedLayout (SmartBorder [])
+ XMonad/Layout/PerWorkspace.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.PerWorkspace+-- Copyright   :  (c) Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Configure layouts on a per-workspace basis.  NOTE that this module+-- does not (yet) work in conjunction with multiple screens! =(+-----------------------------------------------------------------------------++module XMonad.Layout.PerWorkspace (+                                    -- * Usage+                                    -- $usage++                                    onWorkspace, onWorkspaces+                                  ) where++import XMonad+import qualified XMonad.StackSet as W++import Data.Maybe (fromMaybe)++-- $usage+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Layout.PerWorkspace+--+-- and modifying your layoutHook as follows (for example):+--+-- > layoutHook = onWorkspace "foo" l1 $  -- layout l1 will be used on workspace "foo".+-- >              onWorkspaces ["bar","6"] l2 $  -- layout l2 will be used on workspaces "bar" and "6".+-- >              l3                      -- layout l3 will be used on all other workspaces.+--+-- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated layouts,+-- e.g. @(Full ||| smartBorders $ tabbed shrinkText defaultTConf ||| ...)@+--+-- In another scenario, suppose you wanted to have layouts A, B, and C+-- available on all workspaces, except that on workspace foo you want+-- layout D instead of C.  You could do that as follows:+--+-- > layoutHook = A ||| B ||| onWorkspace "foo" D C+--+-- NOTE that this module does not (yet) work in conjunction with+-- multiple screens. =(++-- | Specify one layout to use on a particular workspace, and another+--   to use on all others.  The second layout can be another call to+--   'onWorkspace', and so on.+onWorkspace :: (LayoutClass l1 a, LayoutClass l2 a)+               => WorkspaceId -- ^ the tag of the workspace to match+               -> (l1 a)      -- ^ layout to use on the matched workspace+               -> (l2 a)      -- ^ layout to use everywhere else+               -> PerWorkspace l1 l2 a+onWorkspace wsId l1 l2 = PerWorkspace [wsId] Nothing l1 l2++-- | Specify one layout to use on a particular set of workspaces, and+--   another to use on all other workspaces.+onWorkspaces :: (LayoutClass l1 a, LayoutClass l2 a)+                => [WorkspaceId]  -- ^ tags of workspaces to match+                -> (l1 a)         -- ^ layout to use on matched workspaces+                -> (l2 a)         -- ^ layout to use everywhere else+                -> PerWorkspace l1 l2 a+onWorkspaces wsIds l1 l2 = PerWorkspace wsIds Nothing l1 l2++-- | Structure for representing a workspace-specific layout along with+--   a layout for all other workspaces.  We store the tags of workspaces+--   to be matched, and the two layouts.  Since layouts are stored\/tracked+--   per workspace, once we figure out whether we're on a matched workspace,+--   we can cache that information using a (Maybe Bool).  This is necessary+--   to be able to correctly implement the 'description' method of+--   LayoutClass, since a call to description is not able to query the+--   WM state to find out which workspace it was called in.+data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]+                                         (Maybe Bool)+                                         (l1 a)+                                         (l2 a)+    deriving (Read, Show)++instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (PerWorkspace l1 l2) a where++    -- do layout with l1, then return a modified PerWorkspace caching+    --   the fact that we're in the matched workspace.+    doLayout p@(PerWorkspace _ (Just True) lt _) r s = do+        (wrs, mlt') <- doLayout lt r s+        return (wrs, Just $ mkNewPerWorkspaceT p mlt')++    -- do layout with l1, then return a modified PerWorkspace caching+    --   the fact that we're not in the matched workspace.+    doLayout p@(PerWorkspace _ (Just False) _ lf) r s = do+        (wrs, mlf') <- doLayout lf r s+        return (wrs, Just $ mkNewPerWorkspaceF p mlf')++    -- figure out which layout to use based on the current workspace.+    doLayout (PerWorkspace wsIds Nothing l1 l2) r s = do+        t <- getCurrentTag+        doLayout (PerWorkspace wsIds (Just $ t `elem` wsIds) l1 l2) r s++    -- handle messages; same drill as doLayout.+    handleMessage p@(PerWorkspace _ (Just True) lt _) m = do+        mlt' <- handleMessage lt m+        return . Just $ mkNewPerWorkspaceT p mlt'++    handleMessage p@(PerWorkspace _ (Just False) _ lf) m = do+        mlf' <- handleMessage lf m+        return . Just $ mkNewPerWorkspaceF p mlf'++    handleMessage (PerWorkspace _ Nothing _ _) _ = return Nothing++    description (PerWorkspace _ (Just True ) l1 _) = description l1+    description (PerWorkspace _ (Just False) _ l2) = description l2++    -- description's result is not in the X monad, so we have to wait+    -- until a doLayout for the information about which workspace+    -- we're in to get cached.+    description _ = "PerWorkspace"++-- | Construct new PerWorkspace values with possibly modified layouts.+mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->+                      PerWorkspace l1 l2 a+mkNewPerWorkspaceT (PerWorkspace wsIds b lt lf) mlt' =+    (\lt' -> PerWorkspace wsIds b lt' lf) $ fromMaybe lt mlt'++mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->+                      PerWorkspace l1 l2 a+mkNewPerWorkspaceF (PerWorkspace wsIds b lt lf) mlf' =+    (\lf' -> PerWorkspace wsIds b lt lf') $ fromMaybe lf mlf'++-- | Get the tag of the currently active workspace.  Note that this+--   is only guaranteed to be the same workspace for which doLayout+--   was called if there is only one screen.+getCurrentTag :: X WorkspaceId+getCurrentTag = gets windowset >>= return . W.tag . W.workspace . W.current
+ XMonad/Layout/ResizableTile.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ResizableTile+-- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- More useful tiled layout that allows you to change a width\/height of window.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ResizableTile (+                                    -- * Usage+                                    -- $usage+                                    ResizableTall(..), MirrorResize(..)+                                   ) where++import XMonad hiding (splitVertically, splitHorizontallyBy)+import qualified XMonad.StackSet as W+import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ResizableTile+--+-- Then edit your @layoutHook@ by adding the ResizableTile layout:+--+-- > myLayouts =  ResizableTall 1 (3/100) (1/2) [] ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You may also want to add the following key bindings:+--+-- > , ((modMask x,               xK_a), sendMessage MirrorShrink)+-- > , ((modMask x,               xK_z), sendMessage MirrorExpand)+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable+instance Message MirrorResize++data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read)+instance LayoutClass ResizableTall a where+    doLayout (ResizableTall nmaster _ frac mfrac) r =+        return . (\x->(x,Nothing)) .+        ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate+    handleMessage (ResizableTall nmaster delta frac mfrac) m =+        do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset+           case ms of+             Nothing -> return Nothing+             Just s -> return $ msum [fmap resize (fromMessage m)+                                     ,fmap (\x -> mresize x s) (fromMessage m)+                                     ,fmap incmastern (fromMessage m)]+        where resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac+              resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac+              mresize MirrorShrink s = mresize' s delta+              mresize MirrorExpand s = mresize' s (0-delta)+              mresize' s d = let n = length $ W.up s+                                 total = n + (length $ W.down s) + 1+                                 pos = if n == (nmaster-1) || n == (total-1) then n-1 else n+                                 mfrac' = modifymfrac (mfrac ++ repeat 1) d pos+                             in ResizableTall nmaster delta frac $ take total mfrac'+              modifymfrac [] _ _ = []+              modifymfrac (f:fx) d n | n == 0    = f+d : fx+                                     | otherwise = f : modifymfrac fx d (n-1)+              incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac+    description _ = "ResizableTall"++tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]+tile f mf r nmaster n = if n <= nmaster || nmaster == 0+    then splitVertically mf n r+    else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns+  where (r1,r2) = splitHorizontallyBy f r++splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]+splitVertically [] _ r = [r]+splitVertically _ n r | n < 2 = [r]+splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :+    splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))+  where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map.++splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)+splitHorizontallyBy f (Rectangle sx sy sw sh) =+    ( Rectangle sx sy leftw sh+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)+  where leftw = floor $ fromIntegral sw * f
+ XMonad/Layout/Roledex.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Roledex+-- Copyright   :  (c) tim.thelion@gmail.com+-- License     :  BSD+--+-- Maintainer  :  tim.thelion@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Screenshot  :  <http://www.timthelion.com/rolodex.png>+--+-- This is a completely pointless layout which acts like Microsoft's Flip 3D+-----------------------------------------------------------------------------++module XMonad.Layout.Roledex (+    -- * Usage+    -- $usage+    Roledex(Roledex)) where++import XMonad+import qualified XMonad.StackSet as W+import Data.Ratio++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Roledex +--+-- Then edit your @layoutHook@ by adding the Roledex layout:+--+-- > myLayouts =  Roledex ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Roledex a = Roledex deriving ( Show, Read )++instance LayoutClass Roledex Window where+    doLayout _ = roledexLayout++roledexLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Roledex a))+roledexLayout sc ws = return ([(W.focus ws, mainPane)] +++                              (zip ups tops) +++                              (reverse (zip dns bottoms))+                               ,Nothing)+ where ups    = W.up ws+       dns    = W.down ws+       c = length ups + length dns+       rect = fst $ splitHorizontallyBy (2%3 :: Ratio Int) $ fst (splitVerticallyBy (2%3 :: Ratio Int) sc) +       gw = div' (w - rw) (fromIntegral c) +            where+            (Rectangle _ _ w _) = sc+            (Rectangle _ _ rw _) = rect+       gh = div' (h - rh) (fromIntegral c)+            where+            (Rectangle _ _ _ h) = sc+            (Rectangle _ _ _ rh) = rect+       mainPane = mrect (gw * fromIntegral c) (gh * fromIntegral c) rect +       mrect  mx my (Rectangle x y w h) = Rectangle (x + (fromIntegral mx)) (y + (fromIntegral my)) w h+       tops    = map f $ cd c (length dns)+       bottoms = map f $ [0..(length dns)]+       f n = mrect (gw * (fromIntegral n)) (gh * (fromIntegral n)) rect+       cd n m = if n > m +                then (n - 1) : (cd (n-1) m)+                else []++div' :: Integral a => a -> a -> a+div' _ 0 = 0+div' n o = div n o
+ XMonad/Layout/Spiral.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Spiral+-- Copyright   :  (c) Joe Thornber <joe.thornber@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Joe Thornber <joe.thornber@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- Spiral adds a spiral tiling layout+--+-----------------------------------------------------------------------------++module XMonad.Layout.Spiral (+                             -- * Usage+                             -- $usage+                             spiral+                            , spiralWithDir+                            , Rotation (..)+                            , Direction (..)+                            ) where++import Data.Ratio+import XMonad+import XMonad.StackSet ( integrate )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Spiral+-- > import Data.Ratio+--+-- Then edit your @layoutHook@ by adding the Spiral layout:+--+-- > myLayouts =  spiral (1 % 1) ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++fibs :: [Integer]+fibs = 1 : 1 : zipWith (+) fibs (tail fibs)++mkRatios :: [Integer] -> [Rational]+mkRatios (x1:x2:xs) = (x1 % x2) : mkRatios (x2:xs)+mkRatios _ = []++data Rotation = CW | CCW deriving (Read, Show)+data Direction = East | South | West | North deriving (Eq, Enum, Read, Show)++blend :: Rational -> [Rational] -> [Rational]+blend scale ratios = zipWith (+) ratios scaleFactors+    where+      len = length ratios+      step = (scale - (1 % 1)) / (fromIntegral len)+      scaleFactors = map (* step) . reverse . take len $ [0..]++spiral :: Rational -> SpiralWithDir a+spiral = spiralWithDir East CW++spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a+spiralWithDir = SpiralWithDir++data SpiralWithDir a = SpiralWithDir Direction Rotation Rational+                     deriving ( Read, Show )++instance LayoutClass SpiralWithDir a where+    pureLayout (SpiralWithDir dir rot scale) sc stack = zip ws rects+        where ws = integrate stack+              ratios = blend scale . reverse . take (length ws - 1) . mkRatios $ tail fibs+              rects = divideRects (zip ratios dirs) sc+              dirs  = dropWhile (/= dir) $ case rot of+                                           CW  -> cycle [East .. North]+                                           CCW -> cycle [North, West, South, East]+    handleMessage (SpiralWithDir dir rot scale) = return . fmap resize . fromMessage+        where resize Expand = spiralWithDir dir rot $ (21 % 20) * scale+              resize Shrink = spiralWithDir dir rot $ (20 % 21) * scale+    description _ = "Spiral"++-- This will produce one more rectangle than there are splits details+divideRects :: [(Rational, Direction)] -> Rectangle -> [Rectangle]+divideRects [] r = [r]+divideRects ((r,d):xs) rect = case divideRect r d rect of+                                (r1, r2) -> r1 : (divideRects xs r2)++-- It's much simpler if we work with all Integers and convert to+-- Rectangle at the end.+data Rect = Rect Integer Integer Integer Integer++fromRect :: Rect -> Rectangle+fromRect (Rect x y w h) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)++toRect :: Rectangle -> Rect+toRect (Rectangle x y w h) = Rect (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)++divideRect :: Rational -> Direction -> Rectangle -> (Rectangle, Rectangle)+divideRect r d rect = let (r1, r2) = divideRect' r d $ toRect rect in+                      (fromRect r1, fromRect r2)++divideRect' :: Rational -> Direction -> Rect -> (Rect, Rect)+divideRect' ratio dir (Rect x y w h) =+    case dir of+      East -> let (w1, w2) = chop ratio w in (Rect x y w1 h, Rect (x + w1) y w2 h)+      South -> let (h1, h2) = chop ratio h in (Rect x y w h1, Rect x (y + h1) w h2)+      West -> let (w1, w2) = chop (1 - ratio) w in (Rect (x + w1) y w2 h, Rect x y w1 h)+      North -> let (h1, h2) = chop (1 - ratio) h in (Rect x (y + h1) w h2, Rect x y w h1)++chop :: Rational -> Integer -> (Integer, Integer)+chop rat n = let f = ((fromIntegral n) * (numerator rat)) `div` (denominator rat) in+             (f, n - f)
+ XMonad/Layout/Square.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Square+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout that splits the screen into a square area and the rest of the+-- screen.+-- This is probably only ever useful in combination with+-- "XMonad.Layout.Combo".+-- It sticks one window in a square region, and makes the rest+-- of the windows live with what's left (in a full-screen sense).+--+-----------------------------------------------------------------------------++module XMonad.Layout.Square (+                             -- * Usage+                             -- $usage+                             Square(..) ) where++import XMonad+import XMonad.StackSet ( integrate )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- >   import XMonad.Layout.Square+--+-- An example layout using square together with "XMonad.Layout.Combo"+-- to make the very last area square:+--+-- > , combo (combo (mirror $ twoPane 0.03 0.85),1)] (twoPane 0.03 0.5) )+-- >                [(twoPane 0.03 0.2,1),(combo [(twoPane 0.03 0.8,1),(square,1)]+-- >         [(tabbed,3),(tabbed,30),(tabbed,1),(tabbed,1)]++-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Square a = Square deriving ( Read, Show )++instance LayoutClass Square a where+    pureLayout Square r s = arrange (integrate s)+        where arrange ws@(_:_) = map (\w->(w,rest)) (init ws) ++ [(last ws,sq)]+              arrange [] = [] -- actually, this is an impossible case+              (rest, sq) = splitSquare r++splitSquare :: Rectangle -> (Rectangle, Rectangle)+splitSquare (Rectangle x y w h)+    | w > h = (Rectangle x y (w - h) h, Rectangle (x+fromIntegral (w-h)) y h h)+    | otherwise = (Rectangle x y w (h-w), Rectangle x (y+fromIntegral (h-w)) w w)
+ XMonad/Layout/Tabbed.hs view
@@ -0,0 +1,228 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Tabbed+-- Copyright   :  (c) 2007 David Roundy, Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  droundy@darcs.net, andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A tabbed layout for the Xmonad Window Manager+--+-----------------------------------------------------------------------------++module XMonad.Layout.Tabbed (+                             -- * Usage:+                             -- $usage+                             tabbed+                            , shrinkText, CustomShrink(CustomShrink)+                            , TConf (..), defaultTConf+                            , Shrinker(..)+                            ) where++import Data.Maybe+import Data.List++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Util.NamedWindows+import XMonad.Util.Invisible+import XMonad.Util.XUtils+import XMonad.Util.Font++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Tabbed+--+-- Then edit your @layoutHook@ by adding the Tabbed layout:+--+-- > myLayouts = tabbed shrinkText defaultTConf ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You can also edit the default configuration options.+--+-- > myTabConfig = defaultTConf { inactiveBorderColor = "#FF0000"+-- >                            , activeTextColor = "#00FF00"}+--+-- and+--+-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..++tabbed :: Shrinker s => s -> TConf -> Tabbed s a+tabbed s t = Tabbed (I Nothing) s t++data TConf =+    TConf { activeColor         :: String+          , inactiveColor       :: String+          , activeBorderColor   :: String+          , inactiveTextColor   :: String+          , inactiveBorderColor :: String+          , activeTextColor     :: String+          , fontName            :: String+          , tabSize             :: Int+          } deriving (Show, Read)++defaultTConf :: TConf+defaultTConf =+    TConf { activeColor         = "#999999"+          , inactiveColor       = "#666666"+          , activeBorderColor   = "#FFFFFF"+          , inactiveBorderColor = "#BBBBBB"+          , activeTextColor     = "#FFFFFF"+          , inactiveTextColor   = "#BFBFBF"+          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+          , tabSize             = 20+          }++data TabState =+    TabState { tabsWindows :: [(Window,Window)]+             , scr         :: Rectangle+             , font        :: XMonadFont+    }++data Tabbed s a =+    Tabbed (Invisible Maybe TabState) s TConf+    deriving (Show, Read)++instance Shrinker s => LayoutClass (Tabbed s) Window where+    doLayout (Tabbed ist ishr conf) = doLay ist ishr conf+    handleMessage                   = handleMess+    description _                   = "Tabbed"++doLay :: Shrinker s => Invisible Maybe TabState -> s -> TConf+      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Tabbed s Window))+doLay ist ishr c sc (W.Stack w [] []) = do+  whenIJust ist $ \st -> mapM_ deleteWindow (map fst $ tabsWindows st)+  return ([(w,sc)], Just $ Tabbed (I Nothing) ishr c)+doLay ist ishr c sc@(Rectangle _ _ wid _) s@(W.Stack w _ _) = do+  let ws = W.integrate s+      width = wid `div` fromIntegral (length ws)+  -- initialize state+  st <- case ist of+          (I Nothing  ) -> initState c sc ws+          (I (Just ts)) -> if map snd (tabsWindows ts) == ws && scr ts == sc+                           then return ts+                           else do mapM_ deleteWindow (map fst $ tabsWindows ts)+                                   tws <- createTabs c sc ws+                                   return (ts {scr = sc, tabsWindows = zip tws ws})+  mapM_ showWindow $ map fst $ tabsWindows st+  mapM_ (updateTab ishr c (font st) width) $ tabsWindows st+  return ([(w,shrink c sc)], Just (Tabbed (I (Just st)) ishr c))++handleMess :: Shrinker s => Tabbed s Window -> SomeMessage -> X (Maybe (Tabbed s Window))+handleMess (Tabbed (I (Just st@(TabState {tabsWindows = tws}))) ishr conf) m+    | Just e <- fromMessage m :: Maybe Event = handleEvent ishr conf st e     >> return Nothing+    | Just Hide             == fromMessage m = mapM_ hideWindow (map fst tws) >> return Nothing+    | Just ReleaseResources == fromMessage m = do mapM_ deleteWindow $ map fst tws+                                                  releaseXMF (font st)+                                                  return $ Just $ Tabbed (I Nothing) ishr conf+handleMess _ _  = return Nothing++handleEvent :: Shrinker s => s -> TConf -> TabState -> Event -> X ()+-- button press+handleEvent ishr conf (TabState    {tabsWindows = tws,   scr          = screen, font         = fs})+                      (ButtonEvent {ev_window   = thisw, ev_subwindow = thisbw, ev_event_type = t})+    | t == buttonPress, tl <- map fst tws, thisw `elem` tl || thisbw `elem` tl  = do+  case lookup thisw tws of+    Just x  -> do focus x+                  updateTab ishr conf fs width (thisw, x)+    Nothing -> return ()+    where+      width = rect_width screen`div` fromIntegral (length tws)++handleEvent ishr conf (TabState {tabsWindows = tws,   scr           = screen, font = fs})+                      (AnyEvent {ev_window   = thisw, ev_event_type = t                })+-- expose+    | thisw `elem` (map fst tws) && t == expose         = do+  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)+    where+      width = rect_width screen`div` fromIntegral (length tws)++-- propertyNotify+handleEvent ishr conf (TabState      {tabsWindows = tws, scr = screen, font = fs})+                      (PropertyEvent {ev_window   = thisw})+    | thisw `elem` (map snd tws) = do+  let tabwin = (fst $ fromJust $ find ((== thisw) . snd) tws, thisw)+  updateTab ishr conf fs width tabwin+    where width = rect_width screen `div` fromIntegral (length tws)+-- expose+handleEvent ishr conf (TabState {tabsWindows = tws, scr = screen, font = fs})+                      (ExposeEvent {ev_window   = thisw})+    | thisw `elem` (map fst tws) = do+  updateTab ishr conf fs width (thisw, fromJust $ lookup thisw tws)+    where width = rect_width screen `div` fromIntegral (length tws)+handleEvent _ _ _ _ =  return ()++initState :: TConf -> Rectangle -> [Window] -> X TabState+initState conf sc ws = do+  fs  <- initXMF (fontName conf)+  tws <- createTabs conf sc ws+  return $ TabState (zip tws ws) sc fs++createTabs :: TConf -> Rectangle -> [Window] -> X [Window]+createTabs _ _ [] = return []+createTabs c (Rectangle x y wh ht) owl@(ow:ows) = do+  let wid    = wh `div` (fromIntegral $ length owl)+      height = fromIntegral $ tabSize c+      mask   = Just (exposureMask .|. buttonPressMask)+  d  <- asks display+  w  <- createNewWindow (Rectangle x y wid height) mask (inactiveColor c)+  io $ restackWindows d $ w : [ow]+  ws <- createTabs c (Rectangle (x + fromIntegral wid) y (wh - wid) ht) ows+  return (w:ws)++updateTab :: Shrinker s => s -> TConf -> XMonadFont -> Dimension -> (Window,Window) -> X ()+updateTab ishr c fs wh (tabw,ow) = do+  nw <- getName ow+  let ht                   = fromIntegral $ tabSize c :: Dimension+      focusColor win ic ac = (maybe ic (\focusw -> if focusw == win+                                                   then ac else ic) . W.peek)+                             `fmap` gets windowset+  (bc',borderc',tc') <- focusColor ow+                           (inactiveColor c, inactiveBorderColor c, inactiveTextColor c)+                           (activeColor   c, activeBorderColor   c, activeTextColor   c)+  dpy <- asks display+  let s = shrinkIt ishr+  name <- shrinkWhile s (\n -> do+			   size <- io $ textWidthXMF dpy fs n+			   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)+  paintAndWrite tabw fs wh ht 1 bc' borderc' tc' bc' AlignCenter name++shrink :: TConf -> Rectangle -> Rectangle+shrink c (Rectangle x y w h) =+    Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))++shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String+shrinkWhile sh p x = sw $ sh x+    where sw [n] = return n+          sw [] = return ""+          sw (n:ns) = do+	                cond <- p n+			if cond+			  then sw ns+			  else return n++data CustomShrink = CustomShrink+instance Show CustomShrink where show _ = ""+instance Read CustomShrink where readsPrec _ s = [(CustomShrink,s)]++class (Read s, Show s) => Shrinker s where+    shrinkIt :: s -> String -> [String]++data DefaultShrinker = DefaultShrinker+instance Show DefaultShrinker where show _ = ""+instance Read DefaultShrinker where readsPrec _ s = [(DefaultShrinker,s)]+instance Shrinker DefaultShrinker where+    shrinkIt _ "" = [""]+    shrinkIt s cs = cs : shrinkIt s (init cs)++shrinkText :: DefaultShrinker+shrinkText = DefaultShrinker
+ XMonad/Layout/ThreeColumns.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ThreeColumns+-- Copyright   :  (c) Kai Grossjohann <kai@emptydomain.de>+-- License     :  BSD3-style (see LICENSE)+-- +-- Maintainer  :  ?+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout similar to tall but with three columns.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ThreeColumns (+                              -- * Usage+                              -- $usage+                              ThreeCol(..)+                             ) where++import XMonad+import qualified XMonad.StackSet as W++import Data.Ratio++import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ThreeColumns+--+-- Then edit your @layoutHook@ by adding the ThreeCol layout:+--+-- > myLayouts = ThreeCol 1 (3/100) (1/2) False ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- Use @True@ as the last argument to get a wide layout.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data ThreeCol a = ThreeCol Int Rational Rational deriving (Show,Read)++instance LayoutClass ThreeCol a where+    doLayout (ThreeCol nmaster _ frac) r =+        return . (\x->(x,Nothing)) .+        ap zip (tile3 frac r nmaster . length) . W.integrate+    handleMessage (ThreeCol nmaster delta frac) m =+        return $ msum [fmap resize     (fromMessage m)+                      ,fmap incmastern (fromMessage m)]+            where resize Shrink = ThreeCol nmaster delta (max 0 $ frac-delta)+                  resize Expand = ThreeCol nmaster delta (min 1 $ frac+delta)+                  incmastern (IncMasterN d) = ThreeCol (max 0 (nmaster+d)) delta frac+    description _ = "ThreeCol"++-- | tile3.  Compute window positions using 3 panes+tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+tile3 f r nmaster n +    | n <= nmaster || nmaster == 0 = splitVertically n r+    | n <= nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2+    | otherwise = splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3+  where (r1, r2, r3) = split3HorizontallyBy f r+        (s1, s2) = splitHorizontallyBy f r+        nslave = (n - nmaster)+        nmid = ceiling (nslave % 2)+        nright = (n - nmaster - nmid)++split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)+split3HorizontallyBy f (Rectangle sx sy sw sh) =+    ( Rectangle sx sy leftw sh+    , Rectangle (sx + fromIntegral leftw) sy midw sh+    , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh )+  where leftw = ceiling $ fromIntegral sw * (2/3) * f+        midw = ceiling ( (sw - leftw) % 2 )+        rightw = sw - leftw - midw
+ XMonad/Layout/ToggleLayouts.hs view
@@ -0,0 +1,95 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.ToggleLayouts+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : David Roundy <droundy@darcs.net>+-- Stability    : unstable+-- Portability  : portable+--+-- A module to toggle between two layouts.+-----------------------------------------------------------------------------++module XMonad.Layout.ToggleLayouts (+    -- * Usage+    -- $usage+    toggleLayouts, ToggleLayout(..)+    ) where++import XMonad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ToggleLayouts+--+-- Then edit your @layoutHook@ by adding the ToggleLayouts layout:+--+-- > myLayouts = toggleLayouts Full (Tall 1 (3/100) (1/2)) ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- To toggle between layouts add a key binding like+--+-- >    , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)+--+-- or a key binding like+--+-- >    , ((modMask x .|. controlMask, xK_space), sendMessage (Toggle "Full"))+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data ToggleLayouts lt lf a = ToggleLayouts Bool (lt a) (lf a) deriving (Read,Show)+data ToggleLayout = ToggleLayout | Toggle String deriving (Read,Show,Typeable)+instance Message ToggleLayout++toggleLayouts :: (LayoutClass lt a, LayoutClass lf a) => lt a -> lf a -> ToggleLayouts lt lf a+toggleLayouts = ToggleLayouts False++instance (LayoutClass lt a, LayoutClass lf a) => LayoutClass (ToggleLayouts lt lf) a where+    doLayout (ToggleLayouts True lt lf) r s = do (ws,mlt') <- doLayout lt r s+                                                 return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')+    doLayout (ToggleLayouts False lt lf) r s = do (ws,mlf') <- doLayout lf r s+                                                  return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')+    description (ToggleLayouts True lt _) = description lt+    description (ToggleLayouts False _ lf) = description lf+    handleMessage (ToggleLayouts bool lt lf) m+        | Just ReleaseResources <- fromMessage m =+                                   do mlf' <- handleMessage lf m+                                      mlt' <- handleMessage lt m+                                      return $ case (mlt',mlf') of+                                          (Nothing ,Nothing ) -> Nothing+                                          (Just lt',Nothing ) -> Just $ ToggleLayouts bool lt' lf+                                          (Nothing ,Just lf') -> Just $ ToggleLayouts bool lt lf'+                                          (Just lt',Just lf') -> Just $ ToggleLayouts bool lt' lf'+    handleMessage (ToggleLayouts True lt lf) m+        | Just ToggleLayout <- fromMessage m = do mlt' <- handleMessage lt (SomeMessage Hide)+                                                  let lt' = maybe lt id mlt'+                                                  return $ Just $ ToggleLayouts False lt' lf+        | Just (Toggle d) <- fromMessage m,+          d == description lt || d == description lf =+              do mlt' <- handleMessage lt (SomeMessage Hide)+                 let lt' = maybe lt id mlt'+                 return $ Just $ ToggleLayouts False lt' lf+        | otherwise = do mlt' <- handleMessage lt m+                         return $ fmap (\lt' -> ToggleLayouts True lt' lf) mlt'+    handleMessage (ToggleLayouts False lt lf) m+        | Just ToggleLayout <- fromMessage m = do mlf' <- handleMessage lf (SomeMessage Hide)+                                                  let lf' = maybe lf id mlf'+                                                  return $ Just $ ToggleLayouts True lt lf'+        | Just (Toggle d) <- fromMessage m,+          d == description lt || d == description lf =+              do mlf' <- handleMessage lf (SomeMessage Hide)+                 let lf' = maybe lf id mlf'+                 return $ Just $ ToggleLayouts True lt lf'+        | otherwise = do mlf' <- handleMessage lf m+                         return $ fmap (\lf' -> ToggleLayouts False lt lf') mlf'
+ XMonad/Layout/TwoPane.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TwoPane+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>+-- License     :  BSD3-style (see LICENSE)+-- +-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout that splits the screen horizontally and shows two windows.  The+-- left window is always the master window, and the right is either the+-- currently focused window or the second window in layout order.+--+-----------------------------------------------------------------------------++module XMonad.Layout.TwoPane (+                              -- * Usage+                              -- $usage+                              TwoPane (..)+                             ) where++import XMonad hiding (focus)+import XMonad.StackSet ( focus, up, down)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.TwoPane+--+-- Then edit your @layoutHook@ by adding the TwoPane layout:+--+-- > myLayouts = TwoPane (3/100) (1/2)  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data TwoPane a = +    TwoPane Rational Rational +    deriving ( Show, Read )++instance LayoutClass TwoPane a where+    doLayout (TwoPane _ split) r s = return (arrange r s,Nothing)+        where+          arrange rect st = case reverse (up st) of+                              (master:_) -> [(master,left),(focus st,right)]+                              [] -> case down st of+                                      (next:_) -> [(focus st,left),(next,right)]+                                      [] -> [(focus st, rect)]+              where (left, right) = splitHorizontallyBy split rect++    handleMessage (TwoPane delta split) x = +        return $ case fromMessage x of+                   Just Shrink -> Just (TwoPane delta (split - delta))+                   Just Expand -> Just (TwoPane delta (split + delta))+                   _           -> Nothing+
+ XMonad/Layout/WindowNavigation.hs view
@@ -0,0 +1,218 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.WindowNavigation+-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- WindowNavigation is an extension to allow easy navigation of a workspace.+--+-----------------------------------------------------------------------------++module XMonad.Layout.WindowNavigation (+                                   -- * Usage+                                   -- $usage+                                   windowNavigation, configurableNavigation,+                                   Navigate(..), Direction(..),+                                   MoveWindowToWindow(..),+                                   navigateColor, navigateBrightness,+                                   noNavigateBorders, defaultWNConfig+                                  ) where++import Data.List ( nub, sortBy, (\\) )+import XMonad hiding (Point)+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutModifier+import XMonad.Util.Invisible+import XMonad.Util.XUtils++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.WindowNavigation+--+-- Then edit your @layoutHook@ by adding the WindowNavigation layout modifier+-- to some layout:+--+-- > myLayouts = windowNavigation (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- In keybindings:+--+-- >    , ((modMask x,                 xK_Right), sendMessage $ Go R)+-- >    , ((modMask x,                 xK_Left ), sendMessage $ Go L)+-- >    , ((modMask x,                 xK_Up   ), sendMessage $ Go U)+-- >    , ((modMask x,                 xK_Down ), sendMessage $ Go D)+-- >    , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R)+-- >    , ((modMask x .|. controlMask, xK_Left ), sendMessage $ Swap L)+-- >    , ((modMask x .|. controlMask, xK_Up   ), sendMessage $ Swap U)+-- >    , ((modMask x .|. controlMask, xK_Down ), sendMessage $ Swap D)+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".+++data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )+instance Typeable a => Message (MoveWindowToWindow a)++data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable )+data Direction = U | D | R | L deriving ( Read, Show, Eq )+instance Message Navigate++data WNConfig =+    WNC { brightness    :: Maybe Double -- Indicates a fraction of the focus color.+        , upColor       :: String+        , downColor     :: String+        , leftColor     :: String+        , rightColor    :: String+        } deriving (Show, Read)++noNavigateBorders :: WNConfig+noNavigateBorders =+    defaultWNConfig {brightness = Just 0}++navigateColor :: String -> WNConfig+navigateColor c =+    WNC Nothing c c c c++navigateBrightness :: Double -> WNConfig+navigateBrightness f | f > 1 = navigateBrightness 1+                     | f < 0 = navigateBrightness 0+navigateBrightness f = defaultWNConfig { brightness = Just f }++defaultWNConfig :: WNConfig+defaultWNConfig = WNC (Just 0.5) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF"++data NavigationState a = NS Point [(a,Rectangle)]++data WindowNavigation a = WindowNavigation WNConfig (Invisible Maybe (NavigationState a)) deriving ( Read, Show )++windowNavigation :: LayoutClass l a => l a -> ModifiedLayout WindowNavigation l a+windowNavigation = ModifiedLayout (WindowNavigation defaultWNConfig (I Nothing))++configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout WindowNavigation l a+configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))++instance LayoutModifier WindowNavigation Window where+    redoLayout (WindowNavigation conf (I state)) rscr s wrs =+        do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask+           [uc,dc,lc,rc] <-+               case brightness conf of+               Just frac -> do myc <- averagePixels fbc nbc frac+                               return [myc,myc,myc,myc]+               Nothing -> mapM (stringToPixel dpy) [upColor conf, downColor conf,+                                                    leftColor conf, rightColor conf]+           let dirc U = uc+               dirc D = dc+               dirc L = lc+               dirc R = rc+           let w    = W.focus s+               r    = case filter ((==w).fst) wrs of ((_,x):_) -> x+                                                     []        -> rscr+               pt   = case state of Just (NS ptold _) | ptold `inrect` r -> ptold+                                    _ -> center r+               wrs' = filter ((/=w) . fst) wrs+               wnavigable = nub $ concatMap+                            (\d -> truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L]+               wnavigablec = nub $ concatMap+                            (\d -> map (\(win,_) -> (win,dirc d)) $+                                   truncHead $ sortby d $ filter (inr d pt . snd) wrs') [U,D,R,L]+               wothers = case state of Just (NS _ wo) -> map fst wo+                                       _              -> []+           mapM_ (sc nbc) (wothers \\ map fst wnavigable)+           mapM_ (\(win,c) -> sc c win) wnavigablec+           return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)++    handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m+        | Just (Go d) <- fromMessage m =+                         case sortby d $ filter (inr d pt . snd) wrs of+                         []        -> return Nothing+                         ((w,r):_) -> do modify focusWindowHere+                                         return $ Just $ Left $ WindowNavigation conf $ I $ Just $+                                                NS (centerd d pt r) wrs+                             where focusWindowHere :: XState -> XState+                                   focusWindowHere s+                                       | Just w == W.peek (windowset s) = s+                                       | has w $ W.stack $ W.workspace $ W.current $ windowset s =+                                           s { windowset = until ((Just w ==) . W.peek)+                                                           W.focusUp $ windowset s }+                                       | otherwise = s+                                   has _ Nothing         = False+                                   has x (Just (W.Stack t l rr)) = x `elem` (t : l ++ rr)++        | Just (Swap d) <- fromMessage m =+             case sortby d $ filter (inr d pt . snd) wrs of+             []        -> return Nothing+             ((w,_):_) -> do let swap st = unint (W.focus st) $ map (swapw (W.focus st)) $ W.integrate st+                                 swapw y x | x == w = y+                                           | x == y = w+                                           | otherwise = x+                                 unint f xs = case span (/= f) xs of+                                              (u,_:dn) -> W.Stack { W.focus = f+                                                                  , W.up = reverse u+                                                                  , W.down = dn }+                                              _ -> W.Stack { W.focus = f+                                                           , W.down = xs+                                                           , W.up = [] }+                             windows $ W.modify' swap+                             return Nothing+        | Just (Move d) <- fromMessage m =+             case sortby d $ filter (inr d pt . snd) wrs of+             []        -> return Nothing+             ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)+                             return $ do st <- mst+                                         Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w+        | Just Hide <- fromMessage m =+                       do XConf { normalBorder = nbc } <- ask+                          mapM_ (sc nbc . fst) wrs+                          return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt []+        | Just ReleaseResources <- fromMessage m =+               handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)+    handleMessOrMaybeModifyIt _ _ = return Nothing++truncHead :: [a] -> [a]+truncHead (x:_) = [x]+truncHead [] = []++sc :: Pixel -> Window -> X ()+sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c++center :: Rectangle -> Point+center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2)  (fromIntegral y + fromIntegral h/2)++centerd :: Direction -> Point -> Rectangle -> Point+centerd d (P xx yy) (Rectangle x y w h) | d == U || d == D = P xx (fromIntegral y + fromIntegral h/2)+                                        | otherwise = P (fromIntegral x + fromIntegral w/2) yy++inr :: Direction -> Point -> Rectangle -> Bool+inr D (P x y) (Rectangle l yr w h) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&+                                     y <  fromIntegral yr + fromIntegral h+inr U (P x y) (Rectangle l yr w _) = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&+                                     y >  fromIntegral yr+inr R (P a x) (Rectangle b l _ w)  = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&+                                     a <  fromIntegral b+inr L (P a x) (Rectangle b l c w)  = x >= fromIntegral l && x < fromIntegral l + fromIntegral w &&+                                     a >  fromIntegral b + fromIntegral c++inrect :: Point -> Rectangle -> Bool+inrect (P x y) (Rectangle a b w h) = x >  fromIntegral a && x < fromIntegral a + fromIntegral w &&+                                     y >  fromIntegral b && y < fromIntegral b + fromIntegral h++sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)]+sortby U = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y' y)+sortby D = sortBy (\(_,Rectangle _ y _ _) (_,Rectangle _ y' _ _) -> compare y y')+sortby R = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x x')+sortby L = sortBy (\(_,Rectangle x _ _ _) (_,Rectangle x' _ _ _) -> compare x' x)++data Point = P Double Double
+ XMonad/Layout/WorkspaceDir.hs view
@@ -0,0 +1,88 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.WorkspaceDir+-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- WorkspaceDir is an extension to set the current directory in a workspace.+--+-- Actually, it sets the current directory in a layout, since there's no way I+-- know of to attach a behavior to a workspace.  This means that any terminals+-- (or other programs) pulled up in that workspace (with that layout) will+-- execute in that working directory.  Sort of handy, I think.+--+-- Note this extension requires the 'directory' package to be installed.+--+-----------------------------------------------------------------------------++module XMonad.Layout.WorkspaceDir (+                                   -- * Usage+                                   -- $usage+                                   workspaceDir,+                                   changeDir+                                  ) where++import System.Directory ( setCurrentDirectory, getCurrentDirectory )++import XMonad+import XMonad.Util.Run ( runProcessWithInput )+import XMonad.Prompt ( XPConfig )+import XMonad.Prompt.Directory ( directoryPrompt )+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.WorkspaceDir+--+-- Then edit your @layoutHook@ by adding the Workspace layout modifier+-- to some layout:+--+-- > myLayouts = workspaceDir "~" (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- WorkspaceDir provides also a prompt. To use it you need to import+-- "XMonad.Prompt" and add something like this to your key bindings:+--+-- >  , ((modMask x .|. shiftMask, xK_x     ), changeDir defaultXPConfig)+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Chdir = Chdir String deriving ( Typeable )+instance Message Chdir++data WorkspaceDir a = WorkspaceDir String deriving ( Read, Show )++instance LayoutModifier WorkspaceDir a where+    hook (WorkspaceDir s) = scd s+    handleMess (WorkspaceDir _) m+        | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd+                                                return $ Just $ WorkspaceDir wd'+        | otherwise = return Nothing++workspaceDir :: LayoutClass l a => String -> l a+             -> ModifiedLayout WorkspaceDir l a+workspaceDir s = ModifiedLayout (WorkspaceDir s)++cleanDir :: String -> X String+cleanDir x = scd x >> io getCurrentDirectory++scd :: String -> X ()+scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x)+           catchIO $ setCurrentDirectory x'++changeDir :: XPConfig -> X ()+changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)
+ XMonad/Prompt.hs view
@@ -0,0 +1,701 @@+{-# LANGUAGE ExistentialQuantification #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for writing graphical prompts for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt (+                             -- * Usage+                             -- $usage+                             mkXPrompt+                             , mkXPromptWithReturn+                             , defaultXPConfig+                             , mkComplFunFromList+                             , XPType (..)+                             , XPPosition (..)+                             , XPConfig (..)+                             , XPrompt (..)+                             , ComplFunction+                             -- * X Utilities+                             -- $xutils+                             , mkUnmanagedWindow+                             , fillDrawable+                             -- * Other Utilities+                             -- $utils+                             , getLastWord+                             , skipLastWord+                             , splitInSubListsAt+                             , breakAtSpace+                             , newIndex+                             , newCommand+                             , uniqSort+                             ) where++import XMonad  hiding (config, io)+import qualified XMonad.StackSet as W+import XMonad.Util.Font+import XMonad.Util.XSelection (getSelection)++import Control.Arrow ((&&&))+import Control.Monad.Reader+import Control.Monad.State+import Control.Applicative ((<$>))+import Data.Char+import Data.Maybe+import Data.List+import Data.Set (fromList, toList)+import System.Environment (getEnv)+import System.IO+import System.Posix.Files++-- $usage+-- For usage examples see "XMonad.Prompt.Shell",+-- "XMonad.Prompt.XMonad" or "XMonad.Prompt.Ssh"+--+-- TODO:+--+-- * scrolling the completions that don't fit in the window (?)++type XP = StateT XPState IO++data XPState =+    XPS { dpy                :: Display+        , rootw              :: Window+        , win                :: Window+        , screen             :: Rectangle+        , complWin           :: Maybe Window+        , complWinDim        :: Maybe ComplWindowDim+        , completionFunction :: String -> IO [String]+        , gcon               :: GC+        , fontS              :: XMonadFont+        , xptype             :: XPType+        , command            :: String+        , offset             :: Int+        , history            :: [History]+        , config             :: XPConfig+        }++data XPConfig =+    XPC { font              :: String     -- ^ Font+        , bgColor           :: String     -- ^ Background color+        , fgColor           :: String     -- ^ Font color+        , fgHLight          :: String     -- ^ Font color of a highlighted completion entry+        , bgHLight          :: String     -- ^ Background color of a highlighted completion entry+        , borderColor       :: String     -- ^ Border color+        , promptBorderWidth :: Dimension  -- ^ Border width+        , position          :: XPPosition -- ^ Position: 'Top' or 'Bottom'+        , height            :: Dimension  -- ^ Window height+        , historySize       :: Int        -- ^ The number of history entries to be saved+        } deriving (Show, Read)++data XPType = forall p . XPrompt p => XPT p++instance Show XPType where+    show (XPT p) = showXPrompt p++instance XPrompt XPType where+    showXPrompt = show++-- | The class prompt types must be an instance of. In order to+-- create a prompt you need to create a data type, without parameters,+-- and make it an instance of this class, by implementing a simple+-- method, 'showXPrompt', which will be used to print the string to be+-- displayed in the command line window.+--+-- This is an example of a XPrompt instance definition:+--+-- >     instance XPrompt Shell where+-- >          showXPrompt Shell = "Run: "+class XPrompt t where+    showXPrompt :: t -> String++data XPPosition = Top+                | Bottom+                  deriving (Show,Read)++defaultXPConfig :: XPConfig+defaultXPConfig =+    XPC { font              = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+        , bgColor           = "#333333"+        , fgColor           = "#FFFFFF"+        , fgHLight          = "#000000"+        , bgHLight          = "#BBBBBB"+        , borderColor       = "#FFFFFF"+        , promptBorderWidth = 1+        , position          = Bottom+        , height            = 18+        , historySize       = 256+        }++type ComplFunction = String -> IO [String]++initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction+          -> GC -> XMonadFont -> p -> [History] -> XPConfig -> XPState+initState d rw w s compl gc fonts pt h c =+    XPS d rw w s Nothing Nothing compl gc fonts (XPT pt) "" 0 h c++-- | Same as 'mkXPrompt', except that the action function can have+--   type @String -> X a@, for any @a@, and the final action returned+--   by 'mkXPromptWithReturn' will have type @X (Maybe a)@.  @Nothing@+--   is yielded if the user cancels the prompt (by e.g. hitting Esc or+--   Ctrl-G).  For an example of use, see the 'XMonad.Prompt.Input'+--   module.+mkXPromptWithReturn :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X a)  -> X (Maybe a)+mkXPromptWithReturn t conf compl action = do+  c <- ask+  let d = display c+      rw = theRoot c+  s <- gets $ screenRect . W.screenDetail . W.current . windowset+  w <- liftIO $ createWin d rw conf s+  liftIO $ selectInput d w $ exposureMask .|. keyPressMask+  gc <- liftIO $ createGC d w+  liftIO $ setGraphicsExposures d gc False+  (hist,h) <- liftIO $ readHistory+  fs <- initXMF (font conf)+  let st = initState d rw w s compl gc fs (XPT t) hist conf+  st' <- liftIO $ execStateT runXP st++  releaseXMF fs+  liftIO $ freeGC d gc+  liftIO $ hClose h+  if (command st' /= "")+    then do+      let htw = take (historySize conf) (history st')+      liftIO $ writeHistory htw+      Just <$> action (command st')+    else+      return Nothing++-- | Creates a prompt given:+--+-- * a prompt type, instance of the 'XPrompt' class.+--+-- * a prompt configuration ('defaultXPConfig' can be used as a+-- starting point)+--+-- * a completion function ('mkComplFunFromList' can be used to+-- create a completions function given a list of possible completions)+--+-- * an action to be run: the action must take a string and return 'XMonad.X' ()+mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()+mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return ()++runXP :: XP ()+runXP = do+  st <- get+  let (d,w) = (dpy &&& win) st+  status <- io $ grabKeyboard d w True grabModeAsync grabModeAsync currentTime+  when (status == grabSuccess) $ do+          updateWindows+          eventLoop handle+          io $ ungrabKeyboard d currentTime+  io $ destroyWindow d w+  destroyComplWin+  io $ sync d False++type KeyStroke = (KeySym, String)++eventLoop :: (KeyStroke -> Event -> XP ()) -> XP ()+eventLoop action = do+  d <- gets dpy+  (keysym,string,event) <- io $+            allocaXEvent $ \e -> do+              maskEvent d (exposureMask .|. keyPressMask) e+              ev <- getEvent e+              (ks,s) <- if ev_event_type ev == keyPress+                        then lookupString $ asKeyEvent e+                        else return (Nothing, "")+              return (ks,s,ev)+  action (fromMaybe xK_VoidSymbol keysym,string) event++-- Main event handler+handle :: KeyStroke -> Event -> XP ()+handle k@(ks,_) e@(KeyEvent {ev_event_type = t})+    | t == keyPress && ks == xK_Tab    = do+  c <- getCompletions+  completionHandle c k e+handle ks (KeyEvent {ev_event_type = t, ev_state = m})+    | t == keyPress = keyPressHandle m ks+handle _ (ExposeEvent {ev_window = w}) = do+  st <- get+  when (win st == w) updateWindows+  eventLoop handle+handle _  _ = eventLoop handle++-- completion event handler+completionHandle ::  [String] -> KeyStroke -> Event -> XP ()+completionHandle c (ks,_) (KeyEvent {ev_event_type = t})+    | t == keyPress && ks == xK_Tab = do+  st <- get+  case c of+    [] -> do updateWindows+             eventLoop handle+    l  -> do let new_command = newCommand (command st) l+             modify $ \s ->  s { command = new_command, offset = length new_command }+             redrawWindows c+             eventLoop (completionHandle c)+-- key release+    | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)+-- other keys+completionHandle _ ks (KeyEvent {ev_event_type = t, ev_state = m})+    | t == keyPress = keyPressHandle m ks+-- some other event: go back to main loop+completionHandle _ k e = handle k e++-- | Given a completion and a list of possible completions, returns the+-- index of the next completion in the list+newIndex :: String -> [String] -> Int+newIndex com cl =+    case elemIndex (getLastWord com) cl of+      Just i -> if i >= length cl - 1 then 0 else i + 1+      Nothing -> 0++-- | Given a completion and a list of possible completions, returns the+-- the next completion in the list+newCommand :: String -> [String] -> String+newCommand com cl =+    skipLastWord com ++ (cl !! (newIndex com cl))++-- KeyPresses++data Direction = Prev | Next deriving (Eq,Show,Read)++keyPressHandle :: KeyMask -> KeyStroke -> XP ()+-- commands: ctrl + ... todo+keyPressHandle mask (ks,_)+    | mask == controlMask =+        -- control sequences+        case () of+          _ | ks == xK_u               -> killBefore    >> go+            | ks == xK_k               -> killAfter     >> go+            | ks == xK_a               -> startOfLine   >> go+            | ks == xK_e               -> endOfLine     >> go+            | ks == xK_y               -> pasteString   >> go+            | ks == xK_Delete          -> killWord Next >> go+            | ks == xK_BackSpace       -> killWord Prev >> go+            | ks == xK_g || ks == xK_c -> quit+            | otherwise  -> eventLoop handle -- unhandled control sequence+    | ks == xK_Return    = historyPush       >> return ()+    | ks == xK_BackSpace = deleteString Prev >> go+    | ks == xK_Delete    = deleteString Next >> go+    | ks == xK_Left      = moveCursor   Prev >> go+    | ks == xK_Right     = moveCursor   Next >> go+    | ks == xK_Up        = moveHistory  Prev >> go+    | ks == xK_Down      = moveHistory  Next >> go+    | ks == xK_Home      = startOfLine       >> go+    | ks == xK_End       = endOfLine         >> go+    | ks == xK_Escape    = quit+    where+      go   = updateWindows >> eventLoop handle+      quit = flushString   >> return () -- quit and discard everything+-- insert a character+keyPressHandle _ (_,s)+    | s == "" = eventLoop handle+    | otherwise = do insertString s+                     updateWindows+                     eventLoop handle++-- KeyPress and State++-- | Kill the portion of the command before the cursor+killBefore :: XP ()+killBefore =+  modify $ \s -> s { command = drop (offset s) (command s)+                   , offset  = 0 }++-- | Kill the portion of the command including and after the cursor+killAfter :: XP ()+killAfter =+  modify $ \s -> s { command = take (offset s) (command s) }++-- | Kill the next\/previous word+killWord :: Direction -> XP ()+killWord d = do+  XPS { command = c, offset = o } <- get+  let (f,ss)        = splitAt o c+      delNextWord w =+          case w of+            ' ':x -> x+            word  -> snd . break isSpace $ word+      delPrevWord   = reverse . delNextWord . reverse+      (ncom,noff)   =+          case d of+            Next -> (f ++ delNextWord ss, o)+            Prev -> (delPrevWord f ++ ss, length $ delPrevWord f) -- laziness!!+  modify $ \s -> s { command = ncom, offset = noff}++-- | Put the cursor at the end of line+endOfLine :: XP ()+endOfLine  =+    modify $ \s -> s { offset = length (command s)}++-- | Put the cursor at the start of line+startOfLine :: XP ()+startOfLine  =+    modify $ \s -> s { offset = 0 }++-- |  Flush the command string and reset the offset+flushString :: XP ()+flushString = do+  modify $ \s -> s { command = "", offset = 0}++-- | Insert a character at the cursor position+insertString :: String -> XP ()+insertString str =+  modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)}+  where o oo = oo + length str+        c oc oo | oo >= length oc = oc ++ str+                | otherwise = f ++ str ++ ss+                where (f,ss) = splitAt oo oc++-- | Insert the current X selection string at the cursor position.+pasteString :: XP ()+pasteString = join $ io $ liftM insertString $ getSelection++-- | Remove a character at the cursor position+deleteString :: Direction -> XP ()+deleteString d =+  modify $ \s -> s { command = c (command s) (offset s), offset = o (offset s)}+  where o oo = if d == Prev then max 0 (oo - 1) else oo+        c oc oo+            | oo >= length oc && d == Prev = take (oo - 1) oc+            | oo <  length oc && d == Prev = take (oo - 1) f ++ ss+            | oo <  length oc && d == Next = f ++ tail ss+            | otherwise = oc+            where (f,ss) = splitAt oo oc++-- | move the cursor one position+moveCursor :: Direction -> XP ()+moveCursor d =+  modify $ \s -> s { offset = o (offset s) (command s)}+  where o oo c = if d == Prev then max 0 (oo - 1) else min (length c) (oo + 1)++moveHistory :: Direction -> XP ()+moveHistory d = do+  h <- getHistory+  c <- gets command+  let str = if h /= [] then head h else c+  let nc = case elemIndex c h of+             Just i -> case d of+                         Prev -> h !! (if (i + 1) > (length h - 1) then 0 else i + 1)+                         Next -> h !! (max (i - 1) 0)+             Nothing -> str+  modify $ \s -> s { command = nc, offset = length nc}++-- X Stuff++updateWindows :: XP ()+updateWindows = do+  d <- gets dpy+  drawWin+  c <- getCompletions+  case c  of+    [] -> destroyComplWin >> return ()+    l  -> redrawComplWin l+  io $ sync d False++redrawWindows :: [String] -> XP ()+redrawWindows c = do+  d <- gets dpy+  drawWin+  case c  of+    [] -> return ()+    l  -> redrawComplWin l+  io $ sync d False++createWin :: Display -> Window -> XPConfig -> Rectangle -> IO Window+createWin d rw c s = do+  let (x,y) = case position c of+                Top -> (0,0)+                Bottom -> (0, rect_height s - height c)+  w <- mkUnmanagedWindow d (defaultScreenOfDisplay d) rw+                      (rect_x s + x) (rect_y s + fi y) (rect_width s) (height c)+  mapWindow d w+  return w++drawWin :: XP ()+drawWin = do+  st <- get+  let (c,(d,(w,gc))) = (config &&& dpy &&& win &&& gcon) st+      scr = defaultScreenOfDisplay d+      wh = widthOfScreen scr+      ht = height c+      bw = promptBorderWidth c+  bgcolor <- io $ initColor d (bgColor c)+  border  <- io $ initColor d (borderColor c)+  p <- io $ createPixmap d w wh ht+                         (defaultDepthOfScreen scr)+  io $ fillDrawable d p gc border bgcolor (fi bw) wh ht+  printPrompt p+  io $ copyArea d p w gc 0 0 wh ht 0 0+  io $ freePixmap d p++printPrompt :: Drawable -> XP ()+printPrompt drw = do+  st <- get+  let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st+      (prt,(com,off)) = (show . xptype &&& command &&& offset) st+      str = prt ++ com+      -- break the string in 3 parts: till the cursor, the cursor and the rest+      (f,p,ss) = if off >= length com+                 then (str, " ","") -- add a space: it will be our cursor ;-)+                 else let (a,b) = (splitAt off com)+                      in (prt ++ a, [head b], tail b)+      ht = height c+  fsl <- io $ textWidthXMF (dpy st) fs f+  psl <- io $ textWidthXMF (dpy st) fs p+  (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs str+  let y = fi $ ((ht - fi (asc + desc)) `div` 2) + fi asc+      x = (asc + desc) `div` 2++  let draw = printStringXMF d drw fs gc+  -- print the first part+  draw (fgColor c) (bgColor c) x y f+  -- reverse the colors and print the "cursor" ;-)+  draw (bgColor c) (fgColor c) (x + fromIntegral fsl) y p+  -- reverse the colors and print the rest of the string+  draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss++-- Completions++getCompletions :: XP [String]+getCompletions = do+  s <- get+  io $ (completionFunction s) (getLastWord $ command s)+       `catch` \_ -> return []++setComplWin :: Window -> ComplWindowDim -> XP ()+setComplWin w wi =+  modify (\s -> s { complWin = Just w, complWinDim = Just wi })++destroyComplWin :: XP ()+destroyComplWin = do+  d  <- gets dpy+  cw <- gets complWin+  case cw of+    Just w -> do io $ destroyWindow d w+                 modify (\s -> s { complWin = Nothing, complWinDim = Nothing })+    Nothing -> return ()++type ComplWindowDim = (Position,Position,Dimension,Dimension,Columns,Rows)+type Rows = [Position]+type Columns = [Position]++createComplWin :: ComplWindowDim -> XP Window+createComplWin wi@(x,y,wh,ht,_,_) = do+  st <- get+  let d = dpy st+      scr = defaultScreenOfDisplay d+  w <- io $ mkUnmanagedWindow d scr (rootw st)+                      x y wh ht+  io $ mapWindow d w+  setComplWin w wi+  return w++getComplWinDim :: [String] -> XP ComplWindowDim+getComplWinDim compl = do+  st <- get+  let (c,(scr,fs)) = (config &&& screen &&& fontS) st+      wh = rect_width scr+      ht = height c++  tws <- mapM (textWidthXMF (dpy st) fs) compl+  let max_compl_len =  fromIntegral ((fi ht `div` 2) + maximum tws)+      columns = max 1 $ wh `div` (fi max_compl_len)+      rem_height =  rect_height scr - ht+      (rows,r) = (length compl) `divMod` fi columns+      needed_rows = max 1 (rows + if r == 0 then 0 else 1)+      actual_max_number_of_rows = rem_height `div` ht+      actual_rows = min actual_max_number_of_rows (fi needed_rows)+      actual_height = actual_rows * ht+      (x,y) = case position c of+                Top -> (0,ht)+                Bottom -> (0, (0 + rem_height - actual_height))+  (_,asc,desc,_) <- io $ textExtentsXMF (dpy st) fs $ head compl+  let yp = fi $ (ht + fi (asc - desc)) `div` 2+      xp = (asc + desc) `div` 2+      yy = map fi . take (fi actual_rows) $ [yp,(yp + ht)..]+      xx = take (fi columns) [xp,(xp + max_compl_len)..]++  return (rect_x scr + x, rect_y scr + fi y, wh, actual_height, xx, yy)++drawComplWin :: Window -> [String] -> XP ()+drawComplWin w compl = do+  st <- get+  let c = config st+      d = dpy st+      scr = defaultScreenOfDisplay d+      bw = promptBorderWidth c+      gc = gcon st+  bgcolor <- io $ initColor d (bgColor c)+  border  <- io $ initColor d (borderColor c)++  (_,_,wh,ht,xx,yy) <- getComplWinDim compl++  p <- io $ createPixmap d w wh ht+                         (defaultDepthOfScreen scr)+  io $ fillDrawable d p gc border bgcolor (fi bw) wh ht+  let ac = splitInSubListsAt (length yy) (take ((length xx) * (length yy)) compl)+  printComplList d p gc (fgColor c) (bgColor c) xx yy ac+  io $ copyArea d p w gc 0 0 wh ht 0 0+  io $ freePixmap d p++redrawComplWin ::  [String] -> XP ()+redrawComplWin compl = do+  st <- get+  nwi <- getComplWinDim compl+  let recreate = do destroyComplWin+                    w <- createComplWin nwi+                    drawComplWin w compl+  if (compl /= [] )+     then case complWin st of+            Just w -> case complWinDim st of+                        Just wi -> if nwi == wi -- complWinDim did not change+                                   then drawComplWin w compl -- so update+                                   else recreate+                        Nothing -> recreate+            Nothing -> recreate+     else destroyComplWin++printComplList :: Display -> Drawable -> GC -> String -> String+               -> [Position] -> [Position] -> [[String]] -> XP ()+printComplList _ _ _ _ _ _ _ [] = return ()+printComplList _ _ _ _ _ [] _ _ = return ()+printComplList d drw gc fc bc (x:xs) y (s:ss) = do+  printComplColumn d drw gc fc bc x y s+  printComplList d drw gc fc bc xs y ss++printComplColumn :: Display -> Drawable -> GC -> String -> String+                 -> Position -> [Position] -> [String] -> XP ()+printComplColumn _ _ _ _ _ _ _ [] = return ()+printComplColumn _ _ _ _ _ _ [] _ = return ()+printComplColumn d drw gc fc bc x (y:yy) (s:ss) = do+  printComplString d drw gc fc bc x y s+  printComplColumn d drw gc fc bc x yy ss++printComplString :: Display -> Drawable -> GC -> String -> String+                 -> Position -> Position -> String  -> XP ()+printComplString d drw gc fc bc x y s = do+  st <- get+  if s == getLastWord (command st)+     then printStringXMF d drw (fontS st) gc+                            (fgHLight $ config st) (bgHLight $ config st) x y s+     else printStringXMF d drw (fontS st) gc fc bc x y s++-- History++data History =+    H { prompt :: String+      , command_history :: String+      } deriving (Show, Read, Eq)++historyPush :: XP ()+historyPush = do+  c <- gets command+  when (c /= []) $ modify (\s -> s { history = nub $ H (showXPrompt (xptype s)) c : history s })++getHistory :: XP [String]+getHistory = do+  hist <- gets history+  pt <- gets xptype+  return $ map command_history . filter (\h -> prompt h == showXPrompt pt) $ hist++readHistory :: IO ([History],Handle)+readHistory = do+  home <- getEnv "HOME"+  let path = home ++ "/.xmonad_history"+  f <- fileExist path+  if f then do h <- openFile path ReadMode+               str <- hGetContents h+               case (reads str) of+                 [(hist,_)] -> return (hist,h)+                 [] -> return ([],h)+                 _ -> return ([],h)+       else do h <- openFile path WriteMode+               return ([],h)++writeHistory :: [History] -> IO ()+writeHistory hist = do+  home <- getEnv "HOME"+  let path = home ++ "/.xmonad_history"+  catch (writeFile path (show hist)) (\_ -> do putStrLn "error in writing"; return ())++-- $xutils++-- | Fills a 'Drawable' with a rectangle and a border+fillDrawable :: Display -> Drawable -> GC -> Pixel -> Pixel+             -> Dimension -> Dimension -> Dimension -> IO ()+fillDrawable d drw gc border bgcolor bw wh ht = do+  -- we start with the border+  setForeground d gc border+  fillRectangle d drw gc 0 0 wh ht+  -- here foreground means the background of the text+  setForeground d gc bgcolor+  fillRectangle d drw gc (fi bw) (fi bw) (wh - (bw * 2)) (ht - (bw * 2))++-- | Creates a window with the attribute override_redirect set to True.+-- Windows Managers should not touch this kind of windows.+mkUnmanagedWindow :: Display -> Screen -> Window -> Position+                  -> Position -> Dimension -> Dimension -> IO Window+mkUnmanagedWindow d s rw x y w h = do+  let visual = defaultVisualOfScreen s+      attrmask = cWOverrideRedirect+  allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes True+           createWindow d rw x y w h 0 (defaultDepthOfScreen s)+                        inputOutput visual attrmask attributes++-- $utils++-- | This function takes a list of possible completions and returns a+-- completions function to be used with 'mkXPrompt'+mkComplFunFromList :: [String] -> String -> IO [String]+mkComplFunFromList _ [] = return []+mkComplFunFromList l s =+  return $ filter (\x -> take (length s) x == s) l++-- Lift an IO action into the XP+io :: IO a -> XP a+io = liftIO++-- Shorthand for fromIntegral+fi :: (Num b, Integral a) => a -> b+fi = fromIntegral++-- | Given a maximum length, splits a list into sublists+splitInSubListsAt :: Int -> [a] -> [[a]]+splitInSubListsAt _ [] = []+splitInSubListsAt i x = f : splitInSubListsAt i rest+    where (f,rest) = splitAt i x++-- | Gets the last word of a string or the whole string if formed by+-- only one word+getLastWord :: String -> String+getLastWord = reverse . fst . breakAtSpace . reverse++-- | Skips the last word of the string, if the string is composed by+-- more then one word. Otherwise returns the string.+skipLastWord :: String -> String+skipLastWord = reverse . snd . breakAtSpace . reverse++breakAtSpace :: String -> (String, String)+breakAtSpace s+    | " \\" `isPrefixOf` s2 = (s1 ++ " " ++ s1', s2')+    | otherwise = (s1, s2)+      where (s1, s2 ) = break isSpace s+            (s1',s2') = breakAtSpace $ tail s2++-- | Sort a list and remove duplicates.+uniqSort :: Ord a => [a] -> [a]+uniqSort = toList . fromList
+ XMonad/Prompt/AppendFile.hs view
@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.AppendFile+-- Copyright   :  (c) 2007 Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A prompt for appending a single line of text to a file.  Useful for+-- keeping a file of notes, things to remember for later, and so on---+-- using a keybinding, you can write things down just about as quickly+-- as you think of them, so it doesn't have to interrupt whatever else+-- you're doing.+--+-- Who knows, it might be useful for other purposes as well!+--+-----------------------------------------------------------------------------++module XMonad.Prompt.AppendFile (+                                 -- * Usage+                                 -- $usage++                                 appendFilePrompt+                                ) where++import XMonad.Core+import XMonad.Prompt++import System.IO+import Control.Exception++-- $usage+--+-- You can use this module by importing it, along with+-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.AppendFile+--+-- and adding an appropriate keybinding, for example:+--+-- >  , ((modMask x .|. controlMask, xK_n), appendFilePrompt defaultXPConfig "/home/me/NOTES")+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data AppendFile = AppendFile FilePath++instance XPrompt AppendFile where+    showXPrompt (AppendFile fn) = "Add to " ++ fn ++ ": "++-- | Given an XPrompt configuration and a file path, prompt the user+--   for a line of text, and append it to the given file.+appendFilePrompt :: XPConfig -> FilePath -> X ()+appendFilePrompt c fn = mkXPrompt (AppendFile fn)+                                  c+                                  (const (return []))+                                  (doAppend fn)++-- | Append a string to a file.+doAppend :: FilePath -> String -> X ()+doAppend fn s = io $ bracket (openFile fn AppendMode)+                             hClose+                             (flip hPutStrLn s)
+ XMonad/Prompt/Directory.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Directory+-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy+-- License     :  BSD3+--+-- Maintainer  :  droundy@darcs.net+-- Stability   :  unstable+-- Portability :  unportable+--+-- A directory prompt for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Directory (+                             -- * Usage+                             -- $usage+                             directoryPrompt+                              ) where++import XMonad+import XMonad.Prompt+import XMonad.Util.Run ( runProcessWithInput )++-- $usage+-- For an example usage see "XMonad.Layout.WorkspaceDir"++data Dir = Dir String++instance XPrompt Dir where+    showXPrompt (Dir x) = x++directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()+directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job++getDirCompl :: String -> IO [String]+getDirCompl s = (filter notboring . lines) `fmap`+                runProcessWithInput "/bin/bash" [] ("compgen -A directory " ++ s ++ "\n")++notboring :: String -> Bool+notboring ('.':'.':_) = True+notboring ('.':_) = False+notboring _ = True
+ XMonad/Prompt/Email.hs view
@@ -0,0 +1,63 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Email+-- Copyright   :  (c) 2007 Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A prompt for sending quick, one-line emails, via the standard GNU+-- \'mail\' utility (which must be in your $PATH).  This module is+-- intended mostly as an example of using "XMonad.Prompt.Input" to+-- build an action requiring user input.+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Email (+                            -- * Usage+                            -- $usage+                            emailPrompt+                           ) where++import XMonad.Core+import XMonad.Util.Run+import XMonad.Prompt+import XMonad.Prompt.Input++-- $usage+--+-- You can use this module by importing it, along with+-- "XMonad.Prompt", into your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Email+--+-- and adding an appropriate keybinding, for example:+--+-- >  , ((modMask x .|. controlMask, xK_e), emailPrompt defaultXPConfig addresses)+--+-- where @addresses@ is a list of email addresses that should+-- autocomplete, for example:+--+-- > addresses = ["me@me.com", "mr@big.com", "tom.jones@foo.bar"]+--+-- You can still send email to any address, but sending to these+-- addresses will be faster since you only have to type a few+-- characters and then hit \'tab\'.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++-- | Prompt the user for a recipient, subject, and body, and send an+--   email via the GNU \'mail\' utility.  The second argument is a list+--   of addresses for autocompletion.+emailPrompt :: XPConfig -> [String] -> X ()+emailPrompt c addrs =+    inputPromptWithCompl c "To" (mkComplFunFromList addrs) ?+ \to ->+    inputPrompt c "Subject" ?+ \subj ->+    inputPrompt c "Body" ?+ \body ->+    io $ runProcessWithInput "mail" ["-s", subj, to] (body ++ "\n")+         >> return ()
+ XMonad/Prompt/Input.hs view
@@ -0,0 +1,114 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Input+-- Copyright   :  (c) 2007 Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A generic framework for prompting the user for input and passing it+-- along to some other action.+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Input (+                            -- * Usage+                            -- $usage+                            inputPrompt,+                            inputPromptWithCompl,+                            (?+)+                           ) where++import XMonad.Core+import XMonad.Prompt++-- $usage+--+-- To use this module, import it along with "XMonad.Prompt":+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Input+--+-- This module provides no useful functionality in isolation, but+-- is intended for use in building other actions which require user+-- input.+--+-- For example, suppose Mr. Big wants a way to easily fire his+-- employees. We'll assume that he already has a function+--+-- > fireEmployee :: String -> X ()+--+-- which takes as input the name of an employee, and fires them.  He+-- just wants a convenient way to provide the input for this function+-- from within xmonad.  Here is where the "XMonad.Prompt.Input" module+-- comes into play.  He can use the 'inputPrompt' function to create a+-- prompt, and the '?+' operator to compose the prompt with the+-- @fireEmployee@ action, like so:+--+-- > firingPrompt :: X ()+-- > firingPrompt = inputPrompt defaultXPConfig \"Fire\" ?+ fireEmployee+--+-- If @employees@ contains a list of all his employees, he could also+-- create an autocompleting version, like this:+--+-- > firingPrompt' = inputPromptWithCompl defaultXPConfig \"Fire\"+-- >                     (mkComplFunFromList employees) ?+ fireEmployee+--+-- Now all he has to do is add a keybinding to @firingPrompt@ (or+-- @firingPrompt'@), such as+--+-- >  , ((modMask x .|. controlMask, xK_f),  firingPrompt)+--+-- Now when Mr. Big hits mod-ctrl-f, a prompt will pop up saying+-- \"Fire: \", waiting for him to type the name of someone to fire.+-- If he thinks better of it after hitting mod-ctrl-f and cancels the+-- prompt (e.g. by hitting Esc), the @fireEmployee@ action will not be+-- invoked.+--+-- (For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".)+--+-- "XMonad.Prompt.Input" is also intended to ease the process of+-- developing other modules which require user input. For an example+-- of a module developed using this functionality, see+-- "XMonad.Prompt.Email", which prompts the user for a recipient,+-- subject, and one-line body, and sends a quick email.++data InputPrompt = InputPrompt String++instance XPrompt InputPrompt  where+    showXPrompt (InputPrompt s) = s ++ ": "++-- | Given a prompt configuration and some prompt text, create an X+--   action which pops up a prompt waiting for user input, and returns+--   whatever they type.  Note that the type of the action is @X+--   (Maybe String)@, which reflects the fact that the user might+--   cancel the prompt (resulting in @Nothing@), or enter an input+--   string @s@ (resulting in @Just s@).+inputPrompt :: XPConfig -> String -> X (Maybe String)+inputPrompt c p = inputPromptWithCompl c p (const (return []))++-- | The same as 'inputPrompt', but with a completion function.  The+--   type @ComplFunction@ is @String -> IO [String]@, as defined in+--   "XMonad.Prompt".  The 'mkComplFunFromList' utility function, also+--   defined in "XMonad.Prompt", is useful for creating such a+--   function from a known list of possibilities.+inputPromptWithCompl :: XPConfig -> String -> ComplFunction -> X (Maybe String)+inputPromptWithCompl c p compl = mkXPromptWithReturn (InputPrompt p) c compl return+++infixr 1 ?+++-- | A combinator for hooking up an input prompt action to a function+--   which can take the result of the input prompt and produce another+--   action. If the user cancels the input prompt, the+--   second function will not be run.+--+--   The astute student of types will note that this is actually a+--   very general combinator and has nothing in particular to do+--   with input prompts.  If you find a more general use for it and+--   want to move it to a different module, be my guest.+(?+) :: (Monad m) => m (Maybe a) -> (a -> m ()) -> m ()+x ?+ k = x >>= maybe (return ()) k
+ XMonad/Prompt/Layout.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Layout+-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy+-- License     :  BSD3+--+-- Maintainer  :  droundy@darcs.net+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout-selection prompt for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Layout (+                             -- * Usage+                             -- $usage+                             layoutPrompt+                            ) where++import Data.List ( sort, nub )+import XMonad hiding ( workspaces )+import XMonad.Prompt+import XMonad.StackSet ( workspaces, layout )+import XMonad.Layout.LayoutCombinators ( JumpToLayout(..) )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Layout+--+-- >   , ((modMask x .|. shiftMask, xK_m     ), layoutPrompt defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".+--+-- WARNING: This prompt won't display all possible layouts, because the+-- code to enable this was rejected from xmonad core.  It only displays+-- layouts that are actually in use.  Also, you can only select layouts if+-- you are using NewSelect, rather than the Select defined in xmonad core+-- (which doesn't have this feature).  So all in all, this module is really+-- more a proof-of-principle than something you can actually use+-- productively.++data Wor = Wor String++instance XPrompt Wor where+    showXPrompt (Wor x) = x++layoutPrompt :: XPConfig -> X ()+layoutPrompt c = do ls <- gets (map (description . layout) . workspaces . windowset)+                    mkXPrompt (Wor "") c (mkCompl $ sort $ nub ls) (sendMessage . JumpToLayout)++mkCompl :: [String] -> String -> IO [String]+mkCompl l s = return $ filter (\x -> take (length s) x == s) l
+ XMonad/Prompt/Man.hs view
@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Man+-- Copyright   :  (c) 2007 Valery V. Vorotyntsev+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Valery V. Vorotyntsev <valery.vv@gmail.com>+-- Portability :  non-portable (uses "manpath" and "bash")+--+-- A manual page prompt for XMonad window manager.+--+-- TODO+--+--   * narrow completions by section number, if the one is specified+--     (like @\/etc\/bash_completion@ does)+--+--   * write QuickCheck properties+-----------------------------------------------------------------------------++module XMonad.Prompt.Man (+                          -- * Usage+                          -- $usage+                          manPrompt+                         , getCommandOutput+                         ) where++import XMonad+import XMonad.Prompt+import XMonad.Util.Run+import XMonad.Prompt.Shell (split)++import System.Directory+import System.Process+import System.IO++import qualified Control.Exception as E+import Control.Monad+import Data.List+import Data.Maybe++-- $usage+-- 1. In your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Man+--+-- 2. In your keybindings add something like:+--+-- >     , ((modMask x, xK_F1), manPrompt defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Man = Man++instance XPrompt Man where+    showXPrompt Man = "Manual page: "++-- | Query for manual page to be displayed.+manPrompt :: XPConfig -> X ()+manPrompt c = mkXPrompt Man c manCompl $ runInTerm . (++) "man "++manCompl :: String -> IO [String]+manCompl str | '/' `elem` str = do+  -- XXX It may be better to use readline instead of bash's compgen...+  lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ str ++ "'")+             | otherwise      = do+  mp <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return []+  let sects    = ["man" ++ show n | n <- [1..9 :: Int]]+      dirs     = [d ++ "/" ++ s | d <- split ':' mp, s <- sects]+      stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse+  mans <- forM dirs $ \d -> do+            exists <- doesDirectoryExist d+            if exists+              then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`+                   getDirectoryContents d+              else return []+  mkComplFunFromList (uniqSort $ concat mans) str++-- | Run a command using shell and return its output.+--+-- XXX merge with 'XMonad.Util.Run.runProcessWithInput'?+--+--   * update documentation of the latter (there is no 'Maybe' in result)+--+--   * ask \"gurus\" whether @evaluate (length ...)@ approach is+--     better\/more idiomatic+getCommandOutput :: String -> IO String+getCommandOutput s = do+  (pin, pout, perr, ph) <- runInteractiveCommand s+  hClose pin+  output <- hGetContents pout+  E.evaluate (length output)+  hClose perr+  waitForProcess ph+  return output++stripSuffixes :: Eq a => [[a]] -> [a] -> [a]+stripSuffixes sufs fn =+    head . catMaybes $ map (flip rstrip fn) sufs ++ [Just fn]++rstrip :: Eq a => [a] -> [a] -> Maybe [a]+rstrip suf lst+    | suf `isSuffixOf` lst = Just $ take (length lst - length suf) lst+    | otherwise            = Nothing
+ XMonad/Prompt/Shell.hs view
@@ -0,0 +1,124 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Shell+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A shell prompt for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Shell(+                             -- * Usage+                             -- $usage+                             shellPrompt+                             , getShellCompl+                             , split+                             , prompt+                             , safePrompt+                              ) where++import System.Environment+import Control.Monad+import Data.List+import System.Directory+import System.IO+import XMonad.Util.Run+import XMonad hiding (config)+import XMonad.Prompt++-- $usage+-- 1. In your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Shell+--+-- 2. In your keybindings add something like:+--+-- >   , ((modMask x .|. controlMask, xK_x), shellPrompt defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Shell = Shell++instance XPrompt Shell where+    showXPrompt Shell = "Run: "++shellPrompt :: XPConfig -> X ()+shellPrompt c = do+    cmds <- io $ getCommands+    mkXPrompt Shell c (getShellCompl cmds) spawn++-- | See safe and unsafeSpawn. prompt is an alias for safePrompt;+-- safePrompt and unsafePrompt work on the same principles, but will use+-- XPrompt to interactively query the user for input; the appearance is+-- set by passing an XPConfig as the second argument. The first argument+-- is the program to be run with the interactive input.+-- You would use these like this:+--+-- >     , ((modMask,               xK_b), safePrompt "firefox" greenXPConfig)+-- >     , ((modMask .|. shiftMask, xK_c), prompt ("xterm" ++ " -e") greenXPConfig)+--+-- Note that you want to use safePrompt for Firefox input, as Firefox+-- wants URLs, and unsafePrompt for the XTerm example because this allows+-- you to easily start a terminal executing an arbitrary command, like+-- 'top'.+prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()+prompt = unsafePrompt+safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run+    where run = safeSpawn c+unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run+    where run a = unsafeSpawn $ c ++ " " ++ a++getShellCompl :: [String] -> String -> IO [String]+getShellCompl cmds s | s == "" || last s == ' ' = return []+                     | otherwise                = do+    f <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ s ++ "\n")+    return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s++commandCompletionFunction :: [String] -> String -> [String]+commandCompletionFunction cmds str | '/' `elem` str = []+                                   | otherwise      = filter (isPrefixOf str) cmds++getCommands :: IO [String]+getCommands = do+    p  <- getEnv "PATH" `catch` const (return [])+    let ds = split ':' p+        fp d f = d ++ "/" ++ f+    es <- forM ds $ \d -> do+        exists <- doesDirectoryExist d+        if exists+            then getDirectoryContents d >>= filterM (isExecutable . fp d)+            else return []+    return . uniqSort . concat $ es++isExecutable :: FilePath ->IO Bool+isExecutable f = do+    fe <- doesFileExist f+    if fe+        then fmap executable $ getPermissions f+        else return False++split :: Eq a => a -> [a] -> [[a]]+split _ [] = []+split e l =+    f : split e (rest ls)+        where+          (f,ls) = span (/=e) l+          rest s | s == []   = []+                 | otherwise = tail s++escape :: String -> String+escape []       = ""+escape (' ':xs) = "\\ " ++ escape xs+escape (x:xs)+    | isSpecialChar x = '\\' : x : escape xs+    | otherwise       = x : escape xs++isSpecialChar :: Char -> Bool+isSpecialChar =  flip elem "\\@\"'#?$*()[]{};"
+ XMonad/Prompt/Ssh.hs view
@@ -0,0 +1,105 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Ssh+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A ssh prompt for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Ssh(+                             -- * Usage+                             -- $usage+                             sshPrompt+                              ) where++import XMonad+import XMonad.Util.Run+import XMonad.Prompt++import System.Directory+import System.Environment++import Control.Monad+import Data.List+import Data.Maybe++-- $usage+-- 1. In your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Ssh+--+-- 2. In your keybindings add something like:+--+-- >   , ((modMask x .|. controlMask, xK_s), sshPrompt defaultXPConfig)+--+-- Keep in mind, that if you want to use the completion you have to+-- disable the "HashKnownHosts" option in your ssh_config+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Ssh = Ssh++instance XPrompt Ssh where+    showXPrompt Ssh = "SSH to: "++sshPrompt :: XPConfig -> X ()+sshPrompt c = do+  sc <- io $ sshComplList+  mkXPrompt Ssh c (mkComplFunFromList sc) ssh++ssh :: String -> X ()+ssh s = runInTerm ("ssh " ++ s)++sshComplList :: IO [String]+sshComplList = uniqSort `fmap` liftM2 (++) sshComplListLocal sshComplListGlobal++sshComplListLocal :: IO [String]+sshComplListLocal = do+  h <- getEnv "HOME"+  sshComplListFile $ h ++ "/.ssh/known_hosts"++sshComplListGlobal :: IO [String]+sshComplListGlobal = do+  env <- getEnv "SSH_KNOWN_HOSTS" `catch` (\_ -> return "/nonexistent")+  fs <- mapM fileExists [ env+                        , "/usr/local/etc/ssh/ssh_known_hosts"+                        , "/usr/local/etc/ssh_known_hosts"+                        , "/etc/ssh/ssh_known_hosts"+                        , "/etc/ssh_known_hosts"+                        ]+  case catMaybes fs of+    []    -> return []+    (f:_) -> sshComplListFile' f++sshComplListFile :: String -> IO [String]+sshComplListFile kh = do+  f <- doesFileExist kh+  if f then sshComplListFile' kh+       else return []++sshComplListFile' :: String -> IO [String]+sshComplListFile' kh = do+  l <- readFile kh+  return $ map (takeWhile (/= ',') . concat . take 1 . words)+         $ filter nonComment+         $ lines l++fileExists :: String -> IO (Maybe String)+fileExists kh = do+  f <- doesFileExist kh+  if f then return $ Just kh+       else return Nothing++nonComment :: String -> Bool+nonComment []      = False+nonComment ('#':_) = False+nonComment ('|':_) = False -- hashed, undecodeable+nonComment _       = True
+ XMonad/Prompt/Window.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Window+-- Copyright   :  Devin Mullins <me@twifkak.com>+--                Andrea Rossato <andrea.rossato@unibz.it>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Devin  Mullins <me@twifkak.com>+--                Andrea Rossato <andrea.rossato@unibz.it>+-- Stability   :  unstable+-- Portability :  unportable+--+-- xprompt operations to bring windows to you, and bring you to windows.+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Window+    (+    -- * Usage+    -- $usage+    windowPromptGoto,+    windowPromptBring+    ) where++import qualified Data.Map as M+import Data.List++import qualified XMonad.StackSet as W+import XMonad+import XMonad.Prompt+import XMonad.Actions.WindowBringer++-- $usage+-- WindowPrompt brings windows to you and you to windows.+-- That is to say, it pops up a prompt with window names, in case you forgot+-- where you left your XChat.+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Window+--+-- and in the keys definition:+--+-- > , ((modMask x .|. shiftMask, xK_g     ), windowPromptGoto  defaultXPConfig)+-- > , ((modMask x .|. shiftMask, xK_b     ), windowPromptBring defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data WindowPrompt = Goto | Bring+instance XPrompt WindowPrompt where+    showXPrompt Goto  = "Go to window:  "+    showXPrompt Bring = "Bring me here:  "++windowPromptGoto, windowPromptBring :: XPConfig -> X ()+windowPromptGoto  c = doPrompt Goto  c+windowPromptBring c = doPrompt Bring c++-- | Pops open a prompt with window titles. Choose one, and you will be+-- taken to the corresponding workspace.+doPrompt :: WindowPrompt -> XPConfig -> X ()+doPrompt t c = do+  a <- case t of+         Goto  -> return . gotoAction  =<< windowMapWith (W.tag . fst)+         Bring -> return . bringAction =<< windowMapWith snd+  wm <- windowMapWith id+  mkXPrompt t c (compList wm) a++    where++      winAction a m    = flip whenJust (windows . a) . flip M.lookup m . unescape+      gotoAction       = winAction W.greedyView+      bringAction      = winAction bringWindow+      bringWindow w ws = W.shiftWin (W.tag . W.workspace . W.current $ ws) w ws++      compList m s = return . filter (isPrefixOf s) . map (escape . fst) . M.toList $ m++      escape []       = []+      escape (' ':xs) = "\\ " ++ escape xs+      escape (x  :xs) = x : escape xs++      unescape []            = []+      unescape ('\\':' ':xs) = ' ' : unescape xs+      unescape (x:xs)        = x   : unescape xs
+ XMonad/Prompt/Workspace.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Workspace+-- Copyright   :  (C) 2007 Andrea Rossato, David Roundy+-- License     :  BSD3+--+-- Maintainer  :  droundy@darcs.net+-- Stability   :  unstable+-- Portability :  unportable+--+-- A workspace prompt for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt.Workspace (+                             -- * Usage+                             -- $usage+                             workspacePrompt+                              ) where++import Data.List ( sort )+import XMonad hiding ( workspaces )+import XMonad.Prompt+import XMonad.StackSet ( workspaces, tag )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Workspace+--+-- >   , ((modMask x .|. shiftMask, xK_m     ), workspacePrompt defaultXPConfig (windows . W.shift))+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data Wor = Wor String++instance XPrompt Wor where+    showXPrompt (Wor x) = x++workspacePrompt :: XPConfig -> (String -> X ()) -> X ()+workspacePrompt c job = do ws <- gets (workspaces . windowset)+                           let ts = sort $ map tag ws+                           mkXPrompt (Wor "") c (mkCompl ts) job++mkCompl :: [String] -> String -> IO [String]+mkCompl l s = return $ filter (\x -> take (length s) x == s) l
+ XMonad/Prompt/XMonad.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.XMonad+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A prompt for running XMonad commands+--+-----------------------------------------------------------------------------++module XMonad.Prompt.XMonad (+                             -- * Usage+                             -- $usage+                             xmonadPrompt,+                             xmonadPromptC+                              ) where++import XMonad+import XMonad.Prompt+import XMonad.Actions.Commands (defaultCommands, runCommand')++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.XMonad+--+-- in your keybindings add:+--+-- >   , ((modMask x .|. controlMask, xK_x), xmonadPrompt defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data XMonad = XMonad++instance XPrompt XMonad where+    showXPrompt XMonad = "XMonad: "++xmonadPrompt :: XPConfig -> X ()+xmonadPrompt c = do+    cmds <- defaultCommands+    mkXPrompt XMonad c (mkComplFunFromList (map fst cmds)) runCommand'++-- | An xmonad prompt with a custom command list+xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()+xmonadPromptC commands c = mkXPrompt XMonad c (mkComplFunFromList (map fst commands)) runCommand'
+ XMonad/Util/Anneal.hs view
@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Anneal+-- Copyright   :  (c) David Roundy+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.org>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Requires the 'random' package+--+-----------------------------------------------------------------------------++module XMonad.Util.Anneal (-- * Usage+                           -- $usage+                           Rated(Rated), the_value, the_rating+                          , anneal, annealMax ) where++import System.Random ( StdGen, Random, mkStdGen, randomR )+import Control.Monad.State ( State, runState, put, get, gets, modify )++-- $usage+-- See "XMonad.Layout.Mosaic" for an usage example.++data Rated a b = Rated !a !b+                 deriving ( Show )+instance Functor (Rated a) where+    f `fmap` (Rated v a) = Rated v (f a)++the_value :: Rated a b -> b+the_value (Rated _ b) = b+the_rating :: Rated a b -> a+the_rating (Rated a _) = a++instance Eq a => Eq (Rated a b) where+    (Rated a _) == (Rated a' _) = a == a'+instance Ord a => Ord (Rated a b) where+    compare (Rated a _) (Rated a' _) = compare a a'++anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a+anneal st r sel = runAnneal st r (do_anneal sel)++annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a+annealMax st r sel = runAnneal st (negate . r) (do_anneal sel)++do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a)+do_anneal sel = do sequence_ $ replicate 100 da+                   gets best+    where da = do select_metropolis sel+                  modify $ \s -> s { temperature = temperature s *0.99 }++data Anneal a = A { g :: StdGen+                  , best :: Rated Double a+                  , current :: Rated Double a+                  , rate :: a -> Rated Double a+                  , temperature :: Double }++runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b+runAnneal start r x = fst $ runState x (A { g = mkStdGen 137+                                          , best = Rated (r start) start+                                          , current = Rated (r start) start+                                          , rate = \xx -> Rated (r xx) xx+                                          , temperature = 1.0 })++select_metropolis :: (a -> [a]) -> State (Anneal a) ()+select_metropolis x = do c <- gets current+                         a <- select $ x $ the_value c+                         metropolis a++metropolis :: a -> State (Anneal a) ()+metropolis x = do r <- gets rate+                  c <- gets current+                  t <- gets temperature+                  let rx = r x+                      boltz = exp $ (the_rating c - the_rating rx) / t+                  if rx < c then do modify $ \s -> s { current = rx, best = rx }+                            else do p <- getOne (0,1)+                                    if p < boltz+                                       then modify $ \s -> s { current = rx }+                                       else return ()++select :: [a] -> State (Anneal a) a+select [] = the_value `fmap` gets best+select [x] = return x+select xs = do n <- getOne (0,length xs - 1)+               return (xs !! n)++getOne :: (Random a) => (a,a) -> State (Anneal x) a+getOne bounds = do s <- get+                   (x,g') <- return $ randomR bounds (g s)+                   put $ s { g = g' }+                   return x
+ XMonad/Util/CustomKeys.hs view
@@ -0,0 +1,87 @@+--------------------------------------------------------------------+-- |+-- Module     : XMonad.Util.CustomKeys+-- Copyright  : (c) 2007 Valery V. Vorotyntsev+-- License    : BSD3-style (see LICENSE)+--+-- Maintainer : Valery V. Vorotynsev <valery.vv@gmail.com>+--+-- Customized key bindings.+--+-- (See also "XMonad.Util.EZConfig" in xmonad-contrib.)+--------------------------------------------------------------------++module XMonad.Util.CustomKeys (+                              -- * Usage+                              -- $usage+                               customKeys+                              , customKeysFrom+                              ) where++import XMonad+import Control.Monad.Reader++import qualified Data.Map as M++-- $usage+--+-- 1. In @~\/.xmonad\/xmonad.hs@ add:+--+-- > import XMonad.Util.CustomKeys+--+-- 2. Set key bindings with 'customKeys':+--+-- > main = xmonad defaultConfig { keys = customKeys delkeys inskeys }+-- >     where+-- >       delkeys :: XConfig l -> [(KeyMask, KeySym)]+-- >       delkeys XConfig {modMask = modm} =+-- >           -- we're preferring Futurama to Xinerama here+-- >           [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ]+-- >+-- >       inskeys :: XConfig l -> [((KeyMask, KeySym), X ())]+-- >       inskeys conf@(XConfig {modMask = modm}) =+-- >           [ ((mod1Mask,             xK_F2  ), spawn $ terminal conf)+-- >           , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock")+-- >           , ((mod1Mask,             xK_Down), spawn "amixer set Master 1-")+-- >           , ((mod1Mask,             xK_Up  ), spawn "amixer set Master 1+")+-- >           ]+--+-- 0 (/hidden feature/). You can always replace bindings map+--   entirely. No need to import "CustomKeys" this time:+--+-- > import XMonad+-- > import System.Exit+-- > import qualified Data.Map as M+-- >+-- > main = xmonad defaultConfig {+-- >          keys = \_ -> M.fromList [+-- >                  -- Let me out of here! I want my KDE back! Help! Help!+-- >                  ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] }++-- | Customize 'XMonad.Config.defaultConfig' -- delete needless+-- shortcuts and insert those you will use.+customKeys :: (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete+           -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert+           -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ())+customKeys = customKeysFrom defaultConfig++-- | General variant of 'customKeys': customize key bindings of+-- third-party configuration.+customKeysFrom :: XConfig l -- ^ original configuration+               -> (XConfig Layout -> [(KeyMask, KeySym)]) -- ^ shortcuts to delete+               -> (XConfig Layout -> [((KeyMask, KeySym), X ())]) -- ^ key bindings to insert+               -> XConfig Layout -> M.Map (KeyMask, KeySym) (X ())+customKeysFrom conf = (runReader .) . customize conf++customize :: XConfig l+          -> (XConfig Layout -> [(KeyMask, KeySym)])+          -> (XConfig Layout -> [((KeyMask, KeySym), X ())])+          -> Reader (XConfig Layout) (M.Map (KeyMask, KeySym) (X ()))+customize conf ds is = Reader (keys conf) >>= delete ds >>= insert is++delete :: (MonadReader r m, Ord a) => (r -> [a]) -> M.Map a b -> m (M.Map a b)+delete dels kmap = asks dels >>= return . foldr M.delete kmap++insert :: (MonadReader r m, Ord a) =>+          (r -> [(a, b)]) -> M.Map a b -> m (M.Map a b)+insert ins kmap = asks ins >>= return . foldr (uncurry M.insert) kmap
+ XMonad/Util/Dmenu.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Dmenu+-- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A convenient binding to dmenu.+--+-- Requires the process-1.0 package+--+-----------------------------------------------------------------------------++module XMonad.Util.Dmenu (+                            -- * Usage+                            -- $usage+                            dmenu, dmenuXinerama, dmenuMap+                           ) where++import XMonad+import qualified XMonad.StackSet as W+import qualified Data.Map as M+import XMonad.Util.Run++-- $usage+-- You can use this module with the following in your Config.hs file:+--+-- > import XMonad.Util.Dmenu++-- %import XMonad.Util.Dmenu++-- | Starts dmenu on the current screen. Requires this patch to dmenu:+-- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>+dmenuXinerama :: [String] -> X String+dmenuXinerama opts = do+    curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int+    io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)++dmenu :: [String] -> X String+dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts)++dmenuMap :: M.Map String a -> X (Maybe a)+dmenuMap selectionMap = do+  selection <- dmenu (M.keys selectionMap)+  return $ M.lookup selection selectionMap
+ XMonad/Util/Dzen.hs view
@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Dzen+-- Copyright   :  (c) glasser@mit.edu+-- License     :  BSD+--+-- Maintainer  :  glasser@mit.edu+-- Stability   :  unstable+-- Portability :  unportable+--+-- Handy wrapper for dzen. Requires dzen >= 0.2.4.+--+-----------------------------------------------------------------------------++module XMonad.Util.Dzen (dzen, dzenWithArgs, dzenScreen,+                         seconds) where++import XMonad+import XMonad.Util.Run (runProcessWithInputAndWait, seconds)++-- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds.+-- Example usage:+--+-- > dzen "Hi, mom!" (5 `seconds`)+dzen :: String -> Int -> X ()+dzen str timeout = dzenWithArgs str [] timeout++-- | @dzen str args timeout@ pipes @str@ to dzen2 for @timeout@ seconds, passing @args@ to dzen.+-- Example usage:+--+-- > dzenWithArgs "Hi, dons!" ["-ta", "r"] (5 `seconds`)+dzenWithArgs :: String -> [String] -> Int -> X ()+dzenWithArgs str args timeout = io $ runProcessWithInputAndWait "dzen2" args (unchomp str) timeout+  -- dzen seems to require the input to terminate with exactly one newline.+  where unchomp s@['\n'] = s+        unchomp []       = ['\n']+        unchomp (c:cs)   = c : unchomp cs++-- | @dzenScreen sc str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds, and on screen @sc@.+-- Requires dzen to be compiled with Xinerama support.+dzenScreen :: ScreenId -> String -> Int -> X()+dzenScreen sc str timeout = dzenWithArgs str ["-xs", screen] timeout+    where screen  = toXineramaArg sc+          toXineramaArg n = show ( ((fromIntegral n)+1)::Int )
+ XMonad/Util/EZConfig.hs view
@@ -0,0 +1,61 @@+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.EZConfig+-- Copyright   :  Devin Mullins <me@twifkak.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Devin Mullins <me@twifkak.com>+--+-- Useful helper functions for amending the defaultConfig.+--+-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)+--+--------------------------------------------------------------------++module XMonad.Util.EZConfig (+                             additionalKeys, removeKeys,+                             additionalMouseBindings, removeMouseBindings+                            ) where+-- TODO: write tests++import XMonad++import qualified Data.Map as M++-- |+-- Add or override keybindings from the existing set. Example use:+--+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }+-- >                 `additionalKeys`+-- >                 [ ((mod1Mask, xK_m        ), spawn "echo 'Hi, mom!' | dzen2 -p 4")+-- >                 , ((mod1Mask, xK_BackSpace), withFocused hide) -- N.B. this is an absurd thing to do+-- >                 ]+--+-- This overrides the previous definition of mod-m.+--+-- Note that, unlike in xmonad 0.4 and previous, you can't use modMask to refer+-- to the modMask you configured earlier. You must specify mod1Mask (or+-- whichever), or add your own @myModMask = mod1Mask@ line.+additionalKeys :: XConfig a -> [((ButtonMask, KeySym), X ())] -> XConfig a+additionalKeys conf keysList =+    conf { keys = \cnf -> M.union (M.fromList keysList) (keys conf cnf) }++-- |+-- Remove standard keybindings you're not using. Example use:+--+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }+-- >                 `removeKeys` [(mod1Mask .|. shiftMask, n) | n <- [xK_1 .. xK_9]]+removeKeys :: XConfig a -> [(ButtonMask, KeySym)] -> XConfig a+removeKeys conf keyList =+    conf { keys = \cnf -> keys conf cnf `M.difference` M.fromList (zip keyList $ return ()) }++-- | Like additionalKeys, but for mouseBindings.+additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a+additionalMouseBindings conf mouseBindingsList =+    conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) }++-- | Like removeKeys, but for mouseBindings.+removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a+removeMouseBindings conf mouseBindingList =+    conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`+                                   M.fromList (zip mouseBindingList $ return ()) }
+ XMonad/Util/Font.cpphs view
@@ -0,0 +1,154 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Font+-- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for abstracting a font facility over Core fonts and Xft+--+-----------------------------------------------------------------------------++module XMonad.Util.Font  (+                             -- * Usage:+                             -- $usage+                             XMonadFont(..)+                             , initXMF+                             , releaseXMF+                             , initCoreFont+                             , releaseCoreFont+                             , Align (..)+                             , stringPosition+                             , textWidthXMF+                             , textExtentsXMF+                             , printStringXMF+                             , stringToPixel+                            ) where+++import XMonad+import Foreign++#ifdef XFT+import Data.List+import Graphics.X11.Xft+import Graphics.X11.Xrender+#endif++-- Hide the Core Font/Xft switching here+data XMonadFont = Core FontStruct+#ifdef XFT+                | Xft  XftFont+#endif++-- $usage+-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples++-- | Get the Pixel value for a named color: if an invalid name is+-- given the black pixel will be returned.+stringToPixel :: MonadIO m => Display -> String -> m Pixel+stringToPixel d s = liftIO $ catch getIt fallBack+    where getIt    = initColor d s+          fallBack = const $ return $ blackPixel d (defaultScreen d)+++-- | Given a fontname returns the font structure. If the font name is+--  not valid the default font will be loaded and returned.+initCoreFont :: String -> X FontStruct+initCoreFont s = do+  d <- asks display+  io $ catch (getIt d) (fallBack d)+      where getIt    d = loadQueryFont d s+            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++releaseCoreFont :: FontStruct -> X ()+releaseCoreFont fs = do+  d <- asks display+  io $ freeFont d fs++-- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend+-- Example: 'xft: Sans-10'+initXMF :: String -> X XMonadFont+initXMF s =+#ifdef XFT+  if xftPrefix `isPrefixOf` s then+     do+       dpy <- asks display+       xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)+       return (Xft xftdraw)+  else+#endif+      (initCoreFont s >>= (return . Core))+#ifdef XFT+  where xftPrefix = "xft:"+#endif++releaseXMF :: XMonadFont -> X ()+releaseXMF (Core fs) = releaseCoreFont fs+#ifdef XFT+releaseXMF (Xft xftfont) = do+  dpy <- asks display+  io $ xftFontClose dpy xftfont+#endif++textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int+textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s+#ifdef XFT+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do+    gi <- xftTextExtents dpy xftdraw s+    return $ xglyphinfo_width gi+#endif++textExtentsXMF :: MonadIO m => Display -> XMonadFont -> String -> m (FontDirection,Int32,Int32,CharStruct)+textExtentsXMF _ (Core fs) s = return $ textExtents fs s+#ifdef XFT+textExtentsXMF _ (Xft xftfont) _ = liftIO $ do+    ascent <- xftfont_ascent xftfont+    descent <- xftfont_descent xftfont+    return (error "Font direction touched", fi ascent, fi descent, error "Font overall size touched")+#endif++-- | String position+data Align = AlignCenter | AlignRight | AlignLeft++-- | Return the string x and y 'Position' in a 'Rectangle', given a+-- 'FontStruct' and the 'Align'ment+stringPosition :: XMonadFont -> Rectangle -> Align -> String -> X (Position,Position)+stringPosition fs (Rectangle _ _ w h) al s = do+  dpy <- asks display+  width <- io $ textWidthXMF dpy fs s+  (_,a,d,_) <- io $ textExtentsXMF dpy fs s+  let y         = fi $ ((h - fi (a + d)) `div` 2) + fi a;+      x         = case al of+                     AlignCenter -> fi (w `div` 2) - fi (width `div` 2)+                     AlignLeft   -> 1+                     AlignRight  -> fi (w - (fi width + 1));+  return (x,y)+++printStringXMF :: MonadIO m => Display -> Drawable -> XMonadFont -> GC -> String -> String+            -> Position -> Position -> String  -> m ()+printStringXMF d p (Core fs) gc fc bc x y s = liftIO $ do+         setFont d gc $ fontFromFontStruct fs+         [fc',bc'] <- mapM (stringToPixel d) [fc,bc]+         setForeground   d gc fc'+         setBackground   d gc bc'+         drawImageString d p gc x y s++#ifdef XFT+printStringXMF dpy drw (Xft font) _ fc _ x y s = do+  let screen = defaultScreenOfDisplay dpy;+      colormap = defaultColormapOfScreen screen;+      visual = defaultVisualOfScreen screen;+  liftIO $ withXftDraw dpy drw visual colormap $+         \draw -> withXftColorName dpy visual colormap fc $+                   \color -> xftDrawString draw color font x y s+#endif+++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
+ XMonad/Util/Invisible.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Invisible+-- Copyright   :  (c) 2007 Andrea Rossato, David Roundy+-- License     :  BSD-style (see xmonad/LICENSE)+-- +-- Maintainer  :  andrea.rossato@unibz.it, droundy@darcs.net+-- Stability   :  unstable+-- Portability :  unportable+--+-- A data type to store the layout state+--+-----------------------------------------------------------------------------++module XMonad.Util.Invisible ( +                             -- * Usage:+                             -- $usage+                             Invisible (..)+                            , whenIJust+                            , fromIMaybe+                            ) where++-- $usage+-- A wrapper data type to store layout state that shouldn't be persisted across+-- restarts. A common wrapped type to use is @Maybe a@.+-- Invisible derives trivial definitions for Read and Show, so the wrapped data+-- type need not do so.++newtype Invisible m a = I (m a) deriving (Monad, Functor)++instance (Functor m, Monad m) => Read (Invisible m a) where+    readsPrec _ s = [(fail "Read Invisible", s)]++instance Monad m => Show (Invisible m a) where+    show _ = ""++whenIJust :: (Monad m) => Invisible Maybe a -> (a -> m ()) -> m ()+whenIJust (I (Just x)) f  = f x+whenIJust (I  Nothing) _  = return ()++fromIMaybe :: a -> Invisible Maybe a -> a+fromIMaybe _ (I (Just x)) = x+fromIMaybe a (I  Nothing) = a
+ XMonad/Util/NamedWindows.hs view
@@ -0,0 +1,52 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.NamedWindows+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  David Roundy <droundy@darcs.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module allows you to associate the X titles of windows with+-- them.+--+-----------------------------------------------------------------------------++module XMonad.Util.NamedWindows (+                                   -- * Usage+                                   -- $usage+                                   NamedWindow,+                                   getName,+                                   withNamedWindow,+                                   unName+                                  ) where++import qualified XMonad.StackSet as W ( peek )+++import XMonad++-- $usage+-- See "XMonad.Layout.Tabbed" for an example of its use.+++data NamedWindow = NW !String !Window+instance Eq NamedWindow where+    (NW s _) == (NW s' _) = s == s'+instance Ord NamedWindow where+    compare (NW s _) (NW s' _) = compare s s'+instance Show NamedWindow where+    show (NW n _) = n++getName :: Window -> X NamedWindow+getName w = asks display >>= \d -> do s <- io $ getClassHint d w+                                      n <- maybe (resName s) id `fmap` io (fetchName d w)+                                      return $ NW n w++unName :: NamedWindow -> Window+unName (NW _ w) = w++withNamedWindow :: (NamedWindow -> X ()) -> X ()+withNamedWindow f = do ws <- gets windowset+                       whenJust (W.peek ws) $ \w -> getName w >>= f
+ XMonad/Util/Run.hs view
@@ -0,0 +1,144 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Run+-- Copyright   :  (C) 2007 Spencer Janssen, Andrea Rossato, glasser@mit.edu+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Christian Thiemann <mail@christian-thiemann.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This modules provides several commands to run an external process.+-- It is composed of functions formerly defined in "XMonad.Util.Dmenu" (by+-- Spencer Janssen), "XMonad.Util.Dzen" (by glasser\@mit.edu) and+-- XMonad.Util.RunInXTerm (by Andrea Rossato).+--+-----------------------------------------------------------------------------++module XMonad.Util.Run (+                          -- * Usage+                          -- $usage+                          runProcessWithInput,+                          runProcessWithInputAndWait,+                          safeSpawn,+                          unsafeSpawn,+                          runInTerm,+                          safeRunInTerm,+                          seconds,+                          spawnPipe+                         ) where++import System.Posix.IO+import System.Posix.Process (createSession, forkProcess, executeFile,+                             getProcessStatus)+import Control.Concurrent (threadDelay)+import Control.Exception (try)+import System.Exit (ExitCode(ExitSuccess), exitWith)+import System.IO+import System.Process (runInteractiveProcess, waitForProcess)+import XMonad+import Control.Monad++-- $usage+-- For an example usage of 'runInTerm' see "XMonad.Prompt.Ssh"+--+-- For an example usage of 'runProcessWithInput' see+-- "XMonad.Prompt.DirectoryPrompt", "XMonad.Util.Dmenu",+-- "XMonad.Prompt.ShellPrompt", "XMonad.Actions.WmiiActions",+-- "XMonad.Prompt.WorkspaceDir"+--+-- For an example usage of 'runProcessWithInputAndWait' see+-- "XMonad.Util.Dzen"++-- | Returns Just output if the command succeeded, and Nothing if it didn't.+-- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation.+runProcessWithInput :: FilePath -> [String] -> String -> IO String+runProcessWithInput cmd args input = do+    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing+    hPutStr pin input+    hClose pin+    output <- hGetContents pout+    when (output==output) $ return ()+    hClose pout+    hClose perr+    waitForProcess ph+    return output++-- | Wait is in us+runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()+runProcessWithInputAndWait cmd args input timeout = do+    pid <- forkProcess $ do+       forkProcess $ do -- double fork it over to init+         createSession+         (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing+         hPutStr pin input+         hFlush pin+         threadDelay timeout+         hClose pin+         hClose pout+         hClose perr+         waitForProcess ph+         return ()+       exitWith ExitSuccess+       return ()+    getProcessStatus True False pid+    return ()++-- | Multiplies by ONE MILLION, for use with+-- 'runProcessWithInputAndWait'.+--+-- Use like:+--+-- > (5.5 `seconds`)+seconds :: Rational -> Int+seconds = fromEnum . (* 1000000)++-- | safeSpawn bypasses XMonad's 'spawn' command, because 'spawn' passes+-- strings to \/bin\/sh to be interpreted as shell commands. This is+-- often what one wants, but in many cases the passed string will contain+-- shell metacharacters which one does not want interpreted as such (URLs+-- particularly often have shell metacharacters like \'&\' in them). In+-- this case, it is more useful to specify a file or program to be run+-- and a string to give it as an argument so as to bypass the shell and+-- be certain the program will receive the string as you typed it.+-- unsafeSpawn is an alias for XMonad's 'spawn', to remind one that use+-- of it can be, well, unsafe.+-- Examples:+-- +-- >     , ((modMask, xK_Print), unsafeSpawn "import -window root png:$HOME/xwd-$(date +%s)$$.png")+-- >     , ((modMask, xK_d    ), safeSpawn "firefox" "")+-- +-- Note that the unsafeSpawn example must be unsafe and not safe because+-- it makes use of shell interpretation by relying on @$HOME@ and+-- interpolation, whereas the safeSpawn example can be safe because+-- Firefox doesn't need any arguments if it is just being started.+safeSpawn :: MonadIO m => FilePath -> String -> m ()+safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ())++unsafeSpawn :: MonadIO m => String -> m ()+unsafeSpawn = spawn++-- | Run a given program in the preferred terminal emulator. This uses+-- 'safeSpawn'.+safeRunInTerm :: String -> X ()+safeRunInTerm command = asks (terminal . config) >>= \t -> safeSpawn t ("-e " ++ command)++unsafeRunInTerm, runInTerm :: String -> X ()+unsafeRunInTerm command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " -e " ++ command+runInTerm = unsafeRunInTerm++-- | Launch an external application and return a 'Handle' to its standard input.+spawnPipe :: String -> IO Handle+spawnPipe x = do+    (rd, wr) <- createPipe+    setFdOption wr CloseOnExec True+    h <- fdToHandle wr+    hSetBuffering h LineBuffering+    pid <- forkProcess $ do+        forkProcess $ do+            dupTo rd stdInput+            createSession+            executeFile "/bin/sh" False ["-c", x] Nothing+        exitWith ExitSuccess+    getProcessStatus True False pid+    return h
+ XMonad/Util/XSelection.hs view
@@ -0,0 +1,167 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.XSelection+-- Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman+-- License     :  BSD3+--+-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>,+--                Matthew Sackman <matthew@wellquite.org>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for accessing and manipulating the X Window mouse selection (used in copy and pasting).+-- getSelection and putSelection are adaptations of Hxsel.hs and Hxput.hs from XMonad-utils, available:+--+-- $ darcs get "http:\/\/gorgias.mine.nu\/repos\/xmonad-utils"+-----------------------------------------------------------------------------++module XMonad.Util.XSelection (+                                 -- * Usage+                                 -- $usage+                                 getSelection,+                                 promptSelection,+                                 safePromptSelection,+                                 putSelection) where++import Control.Concurrent (forkIO)+import Control.Exception as E (catch)+import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)+import Data.Bits (shiftL, (.&.), (.|.))+import Data.Char (chr, ord)+import Data.Maybe (fromMaybe)+import Data.Word (Word8)+import XMonad+import XMonad.Util.Run (safeSpawn, unsafeSpawn)++{- $usage+    Add 'import XMonad.Util.XSelection' to the top of Config.hs+    Then make use of getSelection or promptSelection as needed; if+    one wanted to run Firefox with the selection as an argument (say,+    the selection is an URL you just highlighted), then one could add+    to the Config.hs a line like thus:++>  , ((modMask .|. shiftMask, xK_b     ), promptSelection "firefox")++    TODO:+             * Fix Unicode handling. Currently it's still better than calling+               'chr' to translate to ASCII, though.+               As near as I can tell, the mangling happens when the String is+               outputted somewhere, such as via promptSelection's passing through+               the shell, or GHCi printing to the terminal. utf-string has IO functions+               which can fix this, though I do not know have to use them here. It's+               a complex issue; see+               <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>+               and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.++             * Possibly add some more elaborate functionality: Emacs' registers are nice. -}++-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is+-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.+getSelection :: IO String+getSelection = do+  dpy <- openDisplay ""+  let dflt = defaultScreen dpy+  rootw  <- rootWindow dpy dflt+  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0+  p <- internAtom dpy "PRIMARY" True+  ty <- E.catch+               (E.catch+                     (internAtom dpy "UTF8_STRING" False)+                     (\_ -> internAtom dpy "COMPOUND_TEXT" False))+             (\_ -> internAtom dpy "sTring" False)+  clp <- internAtom dpy "BLITZ_SEL_STRING" False+  xConvertSelection dpy p ty clp win currentTime+  allocaXEvent $ \e -> do+    nextEvent dpy e+    ev <- getEvent e+    if ev_event_type ev == selectionNotify+       then do res <- getWindowProperty8 dpy clp win+               return $ decode . map fromIntegral . fromMaybe [] $ res+       else destroyWindow dpy win >> return ""++-- | Set the current X Selection to a given String.+putSelection :: String -> IO ()+putSelection text = do+  dpy <- openDisplay ""+  let dflt = defaultScreen dpy+  rootw  <- rootWindow dpy dflt+  win <- createSimpleWindow dpy rootw 0 0 1 1 0 0 0+  p <- internAtom dpy "PRIMARY" True+  ty <- internAtom dpy "UTF8_STRING" False+  xSetSelectionOwner dpy p win currentTime+  winOwn <- xGetSelectionOwner dpy p+  if winOwn == win+    then do forkIO ((allocaXEvent $ processEvent dpy ty text) >> destroyWindow dpy win) >> return ()+    else do putStrLn "Unable to obtain ownership of the selection" >> destroyWindow dpy win+  return ()+                     where+                       processEvent :: Display -> Atom -> [Char] -> XEventPtr -> IO ()+                       processEvent dpy ty txt e = do+                                                      nextEvent dpy e+                                                      ev <- getEvent e+                                                      if ev_event_type ev == selectionRequest+                                                       then do print ev+                                                               allocaXEvent $ \replyPtr -> do+                                                                 changeProperty8 (ev_event_display ev)+                                                                                 (ev_requestor ev)+                                                                                 (ev_property ev)+                                                                                 ty+                                                                                 propModeReplace+                                                                                 (map (fromIntegral . ord) txt)+                                                                 setSelectionNotify replyPtr (ev_requestor ev) (ev_selection ev)+                                                                                        (ev_target ev) (ev_property ev) (ev_time ev)+                                                                 sendEvent dpy (ev_requestor ev) False noEventMask replyPtr+                                                                 sync dpy False+                                                       else do putStrLn "Unexpected Message Received"+                                                               print ev+                                                      processEvent dpy ty text e++{- | A wrapper around getSelection. Makes it convenient to run a program with the current selection as an argument.+This is convenient for handling URLs, in particular. For example, in your Config.hs you could bind a key to+         @promptSelection \"firefox\"@;+this would allow you to highlight a URL string and then immediately open it up in Firefox.++promptSelection passes strings through the shell; if you do not wish your selected text to be interpreted/mangled+by the shell, use safePromptSelection which will bypass the shell using safeSpawn from Run.hs; see Run.hs for more+details on the advantages/disadvantages of this. -}+promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()+promptSelection = unsafePromptSelection+safePromptSelection app = join $ io $ liftM (safeSpawn app) (getSelection)+unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection++{- | Decode a UTF8 string packed into a list of Word8 values, directly to+   String; does not deal with CChar, hence you will want the counter-intuitive 'map fromIntegral'.+   UTF-8 decoding for internal use in getSelection. This code is copied from Eric Mertens's utf-string library+   <http://code.haskell.org/utf8-string/> (version 0.1), which is BSD-3 licensed, as is this module.+   It'd be better to just import Codec.Binary.UTF8.String (decode), but then users of this would need to install it; Xmonad has enough+   dependencies already. -}+decode :: [Word8] -> String+decode [    ] = ""+decode (c:cs)+  | c < 0x80  = chr (fromEnum c) : decode cs+  | c < 0xc0  = replacement_character : decode cs+  | c < 0xe0  = multi_byte 1 0x1f 0x80+  | c < 0xf0  = multi_byte 2 0xf  0x800+  | c < 0xf8  = multi_byte 3 0x7  0x10000+  | c < 0xfc  = multi_byte 4 0x3  0x200000+  | c < 0xfe  = multi_byte 5 0x1  0x4000000+  | otherwise = replacement_character : decode cs+  where++    replacement_character :: Char+    replacement_character = '\xfffd'++    multi_byte :: Int -> Word8 -> Int -> [Char]+    multi_byte i mask overlong = aux i cs (fromEnum (c .&. mask))+      where+        aux 0 rs acc+          | overlong <= acc && acc <= 0x10ffff &&+            (acc < 0xd800 || 0xdfff < acc)     &&+            (acc < 0xfffe || 0xffff < acc)      = chr acc : decode rs+          | otherwise = replacement_character : decode rs++        aux n (r:rs) acc+          | r .&. 0xc0 == 0x80 = aux (n-1) rs+                               $ shiftL acc 6 .|. fromEnum (r .&. 0x3f)++        aux _ rs     _ = replacement_character : decode rs
+ XMonad/Util/XUtils.hs view
@@ -0,0 +1,135 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.XUtils+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+-- +-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for painting on the screen+--+-----------------------------------------------------------------------------++module XMonad.Util.XUtils  ( +                             -- * Usage:+                             -- $usage+                               averagePixels+                             , createNewWindow+                             , showWindow+                             , hideWindow+                             , deleteWindow+                             , paintWindow+                             , paintAndWrite+			     , stringToPixel+                            ) where+++import Data.Maybe+import XMonad+import XMonad.Util.Font+import Control.Monad++-- $usage+-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" for usage+-- examples++-- | Compute the weighted average the colors of two given Pixel values.+averagePixels :: Pixel -> Pixel -> Double -> X Pixel+averagePixels p1 p2 f =+    do d <- asks display+       let cm = defaultColormap d (defaultScreen d)+       [Color _ r1 g1 b1 _,Color _ r2 g2 b2 _] <- io $ queryColors d cm [Color p1 0 0 0 0,Color p2 0 0 0 0]+       let mn x1 x2 = round (fromIntegral x1 * f + fromIntegral x2 * (1-f))+       Color p _ _ _ _ <- io $ allocColor d cm (Color 0 (mn r1 r2) (mn g1 g2) (mn b1 b2) 0)+       return p+-- | Create a simple window given a rectangle. If Nothing is given+-- only the exposureMask will be set, otherwise the Just value.+-- Use 'showWindow' to map and hideWindow to unmap.+createNewWindow :: Rectangle -> Maybe EventMask -> String -> X Window+createNewWindow (Rectangle x y w h) m col = do+  d   <- asks display+  rw  <- asks theRoot+  c <- stringToPixel d col+  win <- io $ createSimpleWindow d rw x y w h 0 c c+  case m of+    Just em -> io $ selectInput d win em+    Nothing -> io $ selectInput d win exposureMask+  return win++-- | Map a window+showWindow :: Window -> X ()+showWindow w = do+  d <- asks display+  io $ mapWindow d w++-- | unmap a window+hideWindow :: Window -> X ()+hideWindow w = do+  d <- asks display+  io $ unmapWindow d w++-- | destroy a window+deleteWindow :: Window -> X ()+deleteWindow w = do+  d <- asks display+  io $ destroyWindow d w++-- | Fill a window with a rectangle and a border+paintWindow :: Window     -- ^ The window where to draw +            -> Dimension  -- ^ Window width+            -> Dimension  -- ^ Window height +            -> Dimension  -- ^ Border width+            -> String     -- ^ Window background color+            -> String     -- ^ Border color+            -> X ()+paintWindow w wh ht bw c bc =+    paintWindow' w (Rectangle 0 0 wh ht) bw c bc Nothing++-- | Fill a window with a rectangle and a border, and write a string at given position+paintAndWrite :: Window     -- ^ The window where to draw +              -> XMonadFont -- ^ XMonad Font for drawing+              -> Dimension  -- ^ Window width+              -> Dimension  -- ^ Window height +              -> Dimension  -- ^ Border width+              -> String     -- ^ Window background color+              -> String     -- ^ Border color+              -> String     -- ^ String color+              -> String     -- ^ String background color+              -> Align      -- ^ String 'Align'ment+              -> String     -- ^ String to be printed+              -> X ()+paintAndWrite w fs wh ht bw bc borc ffc fbc al str = do+    (x,y) <- stringPosition fs (Rectangle 0 0 wh ht) al str+    paintWindow' w (Rectangle x y wh ht) bw bc borc ms+    where ms    = Just (fs,ffc,fbc,str)++-- This stuff is not exported++paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,String) -> X ()+paintWindow' win (Rectangle x y wh ht) bw color b_color str = do+  d  <- asks display+  p  <- io $ createPixmap d win wh ht (defaultDepthOfScreen $ defaultScreenOfDisplay d)+  gc <- io $ createGC d p+  -- draw+  io $ setGraphicsExposures d gc False+  [color',b_color'] <- mapM (stringToPixel d) [color,b_color]+  -- we start with the border+  io $ setForeground d gc b_color'+  io $ fillRectangle d p gc 0 0 wh ht+  -- and now again+  io $ setForeground d gc color'+  io $ fillRectangle d p gc (fi bw) (fi bw) ((wh - (bw * 2))) (ht - (bw * 2))+  when (isJust str) $ do+    let (xmf,fc,bc,s) = fromJust str+    printStringXMF d p xmf gc fc bc x y s+  -- copy the pixmap over the window+  io $ copyArea      d p win gc 0 0 wh ht 0 0+  -- free the pixmap and GC+  io $ freePixmap    d p+  io $ freeGC        d gc++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
+ scripts/generate-configs view
@@ -0,0 +1,302 @@+#!/bin/bash++# generate-configs - Docstring parser for generating xmonad build configs with+#                    default settings for extensions+# Author: Alex Tarkovsky <alextarkovsky@gmail.com>+# Released into the public domain++# This script parses custom docstrings specifying build-time configuration data+# from xmonad extension source files, then inserts the data into copies of+# xmonad's Config.hs and xmonad.cabal files accordingly.+#+# Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR+#+# OPTIONS:+#   --active,  -a              Insert data in active mode (default: passive)+#   --contrib, -c CONTRIB_DIR  Path to contrib repository base directory+#   --help,    -h              Show help+#   --main,    -m MAIN_DIR     Path to main repository base directory+#   --output,  -o OUTPUT_DIR   Output directory (default: CONTRIB_DIR)+#+# Data parsed from the extension source files is inserted into Config.hs in+# either active or passive mode. The default is passive mode, in which the+# inserted data is commented out. The --active option inserts the data+# uncommented. Data inserted into xmonad.cabal is always inserted in active+# mode regardless of specified options.+#+# The docstring markup can be extended as needed. Currently the following tags+# are defined, shown with some examples:+#+# ~~~~~+#+# %cabalbuilddep+#+#     Cabal build dependency. Value is appended to the "build-depends" line in+#     xmonad.cabal and automatically prefixed with ", ".  NB: Don't embed+#     comments in this tag!+#+# -- %cabalbuilddep readline>=1.0+#+# %def+#+#     General definition. Value is appended to the end of Config.sh.+#+# -- %def commands :: [(String, X ())]+# -- %def commands = defaultCommands+#+# %import+#+#     Module needed by Config.sh to build the extension. Value is appended to+#     the end of the default import list in Config.sh and automatically+#     prefixed with "import ".+#+# -- %import XMonad.Layout.Accordion+# -- %import qualified XMonad.Actions.FlexibleManipulate as Flex+#+# %keybind+#+#     Tuple defining a key binding. Must be prefixed with ", ". Value is+#     inserted at the end of the "keys" list in Config.sh.+#+# -- %keybind , ((modMask, xK_d), date)+#+# %keybindlist+#+#     Same as %keybind, but instead of a key binding tuple the definition is a+#     list of key binding tuples (or a list comprehension producing them). This+#     list is concatenated to the "keys" list must begin with the "++" operator+#     rather than ", ".+#+# -- %keybindlist +++# -- %keybindlist -- mod-[1..9] @@ Switch to workspace N+# -- %keybindlist -- mod-shift-[1..9] @@ Move client to workspace N+# -- %keybindlist -- mod-control-shift-[1..9] @@ Copy client to workspace N+# -- %keybindlist [((m .|. modMask, k), f i)+# -- %keybindlist     | (i, k) <- zip [0..fromIntegral (workspaces-1)] [xK_1 ..]+# -- %keybindlist     , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]+#+# %layout+#+#     A layout. Must be prefixed with ", ". Value is inserted at the end of the+#     "defaultLayouts" list in Config.sh.+#+# -- %layout , accordion+#+# %mousebind+#+#     Tuple defining a mouse binding. Must be prefixed with ", ". Value is+#     inserted at the end of the "mouseBindings" list in Config.sh.+#+# -- %mousebind , ((modMask, button3), (\\w -> focus w >> Flex.mouseResizeWindow w))+#+# ~~~~~+#+# NB: '/' and '\' characters must be escaped with a '\' character!+#+# Tags may also contain comments, as illustrated in the %keybindlist examples+# above. Comments are a good place for special user instructions:+#+# -- %def -- comment out default logHook definition above if you uncomment this:+# -- %def logHook = dynamicLog++# Markup tag to search for in source files.+TAG_CABALBUILDDEP="%cabalbuilddep"+TAG_DEF="%def"+TAG_IMPORT="%import"+TAG_KEYBIND="%keybind"+TAG_KEYBINDLIST="%keybindlist"+TAG_LAYOUT="%layout"+TAG_MOUSEBIND="%mousebind"++# Insert markers to search for in Config.sh and xmonad.cabal. Values are+# extended sed regular expressions.+INS_MARKER_CABALBUILDDEP='^build-depends:.*'+INS_MARKER_IMPORT='-- % Extension-provided imports$'+INS_MARKER_LAYOUT='-- % Extension-provided layouts$'+INS_MARKER_KEYBIND='-- % Extension-provided key bindings$'+INS_MARKER_KEYBINDLIST='-- % Extension-provided key bindings lists$'+INS_MARKER_MOUSEBIND='-- % Extension-provided mouse bindings$'+INS_MARKER_DEF='-- % Extension-provided definitions$'++# Literal indentation strings. Values may contain escaped chars such as \t.+INS_INDENT_CABALBUILDDEP=""+INS_INDENT_DEF=""+INS_INDENT_IMPORT=""+INS_INDENT_KEYBIND="    "+INS_INDENT_KEYBINDLIST="    "+INS_INDENT_LAYOUT="                 "+INS_INDENT_MOUSEBIND="    "++# Prefix applied to inserted passive data after indent strings have been applied.+INS_PREFIX_DEF="-- "+INS_PREFIX_IMPORT="--import "+INS_PREFIX_KEYBIND="-- "+INS_PREFIX_KEYBINDLIST="-- "+INS_PREFIX_LAYOUT="-- "+INS_PREFIX_MOUSEBIND="-- "++# Prefix applied to inserted active data after indent strings have been applied.+ACTIVE_INS_PREFIX_CABALBUILDDEP=", "+ACTIVE_INS_PREFIX_DEF=""+ACTIVE_INS_PREFIX_IMPORT="import "+ACTIVE_INS_PREFIX_KEYBIND=""+ACTIVE_INS_PREFIX_KEYBINDLIST=""+ACTIVE_INS_PREFIX_LAYOUT=""+ACTIVE_INS_PREFIX_MOUSEBIND=""++# Don't touch these+opt_active=0+opt_contrib=""+opt_main=""+opt_output=""++generate_configs() {+    for extension_srcfile in $(ls --color=never -1 "${opt_contrib}"/*.hs | head -n -1 | sort -r) ; do+        for tag in $TAG_CABALBUILDDEP \+                   $TAG_DEF \+                   $TAG_IMPORT \+                   $TAG_KEYBIND \+                   $TAG_KEYBINDLIST \+                   $TAG_LAYOUT \+                   $TAG_MOUSEBIND ; do++            ifs="$IFS"+            IFS=$'\n'+            tags=( $(sed -n -r -e "s/^.*--\s*${tag}\s//p" "${extension_srcfile}") )+            IFS="${ifs}"++            case $tag in+                $TAG_CABALBUILDDEP) ins_indent=$INS_INDENT_CABALBUILDDEP+                                    ins_marker=$INS_MARKER_CABALBUILDDEP+                                    ins_prefix=$ACTIVE_INS_PREFIX_CABALBUILDDEP+                                    ;;+                $TAG_DEF)           ins_indent=$INS_INDENT_DEF+                                    ins_marker=$INS_MARKER_DEF+                                    ins_prefix=$INS_PREFIX_DEF+                                    ;;+                $TAG_IMPORT)        ins_indent=$INS_INDENT_IMPORT+                                    ins_marker=$INS_MARKER_IMPORT+                                    ins_prefix=$INS_PREFIX_IMPORT+                                    ;;+                $TAG_KEYBIND)       ins_indent=$INS_INDENT_KEYBIND+                                    ins_marker=$INS_MARKER_KEYBIND+                                    ins_prefix=$INS_PREFIX_KEYBIND+                                    ;;+                $TAG_KEYBINDLIST)   ins_indent=$INS_INDENT_KEYBINDLIST+                                    ins_marker=$INS_MARKER_KEYBINDLIST+                                    ins_prefix=$INS_PREFIX_KEYBINDLIST+                                    ;;+                $TAG_LAYOUT)        ins_indent=$INS_INDENT_LAYOUT+                                    ins_marker=$INS_MARKER_LAYOUT+                                    ins_prefix=$INS_PREFIX_LAYOUT+                                    ;;+                $TAG_MOUSEBIND)     ins_indent=$INS_INDENT_MOUSEBIND+                                    ins_marker=$INS_MARKER_MOUSEBIND+                                    ins_prefix=$INS_PREFIX_MOUSEBIND+                                    ;;+            esac++            # Insert in reverse so values will ultimately appear in correct order.+            for i in $( seq $(( ${#tags[*]} - 1 )) -1 0 ) ; do+                [ -z "${tags[i]}" ] && continue+                if [[ $tag == $TAG_CABALBUILDDEP ]] ; then+                    sed -i -r -e "s/${ins_marker}/\\0${ins_prefix}${tags[i]}/" "${CABAL_FILE}"+                else+                    sed -i -r -e "/${ins_marker}/{G;s/$/${ins_indent}${ins_prefix}${tags[i]}/;}" "${CONFIG_FILE}"+                fi+            done++            if [[ $tag != $TAG_CABALBUILDDEP && -n "${tags}" ]] ; then+                ins_group_comment="${ins_indent}--   For extension $(basename $extension_srcfile .hs):"+                sed -i -r -e "/${ins_marker}/{G;s/$/${ins_group_comment}/;}" "${CONFIG_FILE}"+            fi+        done+    done+}++parse_opts() {+    [[ -z "$1" ]] && show_usage 1++    while [[ $# > 0 ]] ; do+        case "$1" in+            --active|-a)  opt_active=1+                          shift ;;++            --contrib|-c) shift+                          if [[ -z "$1" || ! -d "$1" ]] ; then+                              echo "Error: Option --contrib requires a directory as argument. See: generate-configs -h"+                              exit 1+                          fi+                          opt_contrib="$1"+                          shift ;;++            --help|-h)    show_usage ;;++            --main|-m)    shift+                          if [[ -z "$1" || ! -d "$1" ]] ; then+                              echo "Error: Option --main requires a directory as argument. See: generate-configs -h"+                              exit 1+                          fi+                          opt_main="$1"+                          shift ;;++            --output|-o)  shift+                          if [[ -z "$1" || ! -d "$1" ]] ; then+                              echo "Error: Option --output requires a directory as argument. See: generate-configs -h"+                              exit 1+                          fi+                          opt_output="$1"+                          shift ;;++            -*)           echo "Error: Unknown option ${1}. See: generate-configs -h"+                          exit 1 ;;++            *)            show_usage 1 ;;+        esac+    done++    if [[ -z "$opt_main" ]] ; then+      echo "Error: Missing required option --main. See: generate-configs -h"+      exit 1+    fi++    if [[ -z "$opt_contrib" ]] ; then+      echo "Error: Missing required option --contrib. See: generate-configs -h"+      exit 1+    fi+}++show_usage() {+cat << EOF+Usage: generate-configs [ OPTIONS ] --main MAIN_DIR --contrib CONTRIB_DIR++OPTIONS:+  --active,  -a              Insert data in active mode (default: passive)+  --contrib, -c CONTRIB_DIR  Path to contrib repository base directory+  --help,    -h              Show help+  --main,    -m MAIN_DIR     Path to main repository base directory+  --output,  -o OUTPUT_DIR   Output directory (default: CONTRIB_DIR)+EOF+    exit ${1:-0}+}++parse_opts $*++[[ -z "$opt_output" ]] && opt_output="$opt_contrib"++CABAL_FILE="${opt_output}/xmonad.cabal"+CONFIG_FILE="${opt_output}/Config.hs"++cp -f "${opt_main}/xmonad.cabal" "${CABAL_FILE}"+cp -f "${opt_main}/Config.hs" "${CONFIG_FILE}"++if [[ $opt_active == 1 ]] ; then+    INS_PREFIX_DEF=$ACTIVE_INS_PREFIX_DEF+    INS_PREFIX_IMPORT=$ACTIVE_INS_PREFIX_IMPORT+    INS_PREFIX_KEYBIND=$ACTIVE_INS_PREFIX_KEYBIND+    INS_PREFIX_KEYBINDLIST=$ACTIVE_INS_PREFIX_KEYBINDLIST+    INS_PREFIX_LAYOUT=$ACTIVE_INS_PREFIX_LAYOUT+    INS_PREFIX_MOUSEBIND=$ACTIVE_INS_PREFIX_MOUSEBIND+fi++generate_configs
+ scripts/run-xmonad.sh view
@@ -0,0 +1,41 @@+#!/bin/sh+#+# launch xmonad, with a couple of dzens to run the status bar+# send xmonad state over a named pipe+#++FG='#a8a3f7' +BG='#3f3c6d' +FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1"++PATH=${HOME}/bin:$PATH++# simple xmonad use, no interactive status bar.+#+#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT &+#xmonad++#+# with a pipe talking to an external program+#+PIPE=$HOME/.xmonad-status+rm -f $PIPE+PATH=${PATH}:/sbin mkfifo -m 600 $PIPE+[ -p $PIPE ] || exit++# launch the external 60 second clock, and launch the workspace status bar+xmonad-clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT &++# and a workspace status bar+dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT < $PIPE &++# go for it+xmonad > $PIPE & ++# wait for xmonad+wait $!++pkill -HUP dzen2+pkill -HUP -f xmonad-clock++wait
+ scripts/xinitrc view
@@ -0,0 +1,46 @@+# .xinitrc++xrandr -s 0++xrdb $HOME/.Xresources+xsetroot -cursor_name left_ptr+xsetroot -solid '#80a0af'++# if we have private ssh key(s), start ssh-agent and add the key(s)+id1=$HOME/.ssh/identity+id2=$HOME/.ssh/id_dsa+id3=$HOME/.ssh/id_rsa+if [ -x /usr/bin/ssh-agent ] && [ -f $id1 -o -f $id2 -o -f $id3 ];+then+	eval `ssh-agent -s`+	ssh-add < /dev/null+fi++xset fp+ /usr/local/lib/X11/fonts/terminus+xset fp+ /usr/local/lib/X11/fonts/ghostscript+xset fp+ /usr/X11R6/lib/X11/fonts/TTF/++# xset fp rehash+xset b 100 0 0+xset r rate 140 200++xmodmap -e "keycode 233 = Page_Down"+xmodmap -e "keycode 234 = Page_Up"+xmodmap -e "remove Lock = Caps_Lock"+xmodmap -e "keysym Caps_Lock = Control_L"+xmodmap -e "add Control = Control_L"++PATH=/home/dons/bin:$PATH++# launch the external 60 second clock, and launch the workspace status bar+FG='#a8a3f7' +BG='#3f3c6d' +xmonad-clock | dzen2 -e '' -x 400 -w 1200 -ta r -fg $FG -bg $BG &++xmonad &++# wait for xmonad+wait $!+pkill -HUP dzen2+pkill -HUP -f xmonad-clock+wait
+ scripts/xmonad-acpi.c view
@@ -0,0 +1,82 @@+/*++dwm/xmonad status bar provider. launch from your .xinitrc, and pipe+into dzen2.+ +to compile: gcc -Os -s -o xmonad-acpi xmonad-acpi.c+ +Copyright (c) 2007, Tom Menari <tom dot menari at googlemail dot com>+Copyright (c) 2007, Don Stewart+ +Permission to use, copy, modify, and distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.+ +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.+*/+ +#include <stdio.h>+#include <time.h>+#include <unistd.h>+#include <stdlib.h>+#include <signal.h>+ +/* configuration */+#define REFRESH_RATE    2+#define TIME_FORMAT     "%a %b %d %H:%M:%S" +#define BATTERY_INFO    "/proc/acpi/battery/BAT0/info"+#define BATTERY_STATE   "/proc/acpi/battery/BAT0/state"+ +int main(void) {+    FILE *acpi;+    char b[34];+    time_t epochtime;+    struct tm *realtime;+    int last_full, remaining;++    double load[3];+ +    signal(SIGPIPE, SIG_IGN);++    if ((acpi = fopen(BATTERY_INFO, "r")) == NULL) {+        perror("couldn't open "BATTERY_INFO);+        exit(-1);+    }+    while (fgets(b, sizeof(b), acpi)) +        if (sscanf(b, "last full capacity: %d", &last_full) == 1)+            break;+    fclose(acpi);+ +    for(;;) {+        /* Load */+        getloadavg(load, 3);++        /* Battery */+        if ((acpi = fopen(BATTERY_STATE, "r")) == NULL) {+            perror("couldn't open "BATTERY_STATE);+            exit(-1);+        }+        while (fgets(b, sizeof(b), acpi))+            if (sscanf(b, "remaining capacity: %d", &remaining) == 1)+                break;+        fclose(acpi);+        +        /* Time */+        epochtime = time(NULL);+        realtime  = localtime(&epochtime);+        strftime(b, sizeof(b), TIME_FORMAT, realtime);+++        fprintf(stdout, "%s | %.2f %.2f %.2f | %.1f%% \n", b, load[0], load[1], +                load[2], (float) (remaining * 100) / last_full);+        fflush(stdout);+        sleep(REFRESH_RATE);+    }+    return EXIT_SUCCESS;+}
+ scripts/xmonad-clock.c view
@@ -0,0 +1,67 @@+/*++dwm/xmonad status bar provider. launch from your .xinitrc, and pipe+into dzen2.+ +to compile: gcc -Os -s -o xmonad-clock xmonad-clock.c+ +Copyright (c) 2007, Tom Menari <tom dot menari at googlemail dot com>+Copyright (c) 2007, Don Stewart+ +Permission to use, copy, modify, and distribute this software for any+purpose with or without fee is hereby granted, provided that the above+copyright notice and this permission notice appear in all copies.+ +THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.+*/+ +#include <stdio.h>+#include <time.h>+#include <unistd.h>+#include <stdlib.h>+#include <signal.h>+ +/* configuration */+#define REFRESH_RATE    60+#define TIME_FORMAT     "%H.%M %a %b %d" +#define TIME_FORMAT2    "SYD %H.%M"+ +int main(void) {+    char b[34];+    char c[34];+    time_t epochtime;+    struct tm *realtime;++    time_t pdttime;+    struct tm *pdtrealtime;++    double load[3];+ +    signal(SIGPIPE, SIG_IGN);+ +    for(;;) {+        getloadavg(load, 3);+ +        epochtime = time(NULL);+        realtime  = localtime(&epochtime);+        strftime(b, sizeof(b), TIME_FORMAT, realtime);++        setenv("TZ","Australia/Sydney", 1);+        pdttime      = time(NULL);+        pdtrealtime  = localtime(&pdttime);+        strftime(c, sizeof(c), TIME_FORMAT2, pdtrealtime);+        unsetenv("TZ");++        fprintf(stdout, "%s | %s | %.2f %.2f %.2f | xmonad 0.3 \n", b, c, load[0], load[1], load[2]);++        fflush(stdout);+        sleep(REFRESH_RATE);+    }+    return EXIT_SUCCESS;+}
+ tests/test_SwapWorkspaces.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS -fglasgow-exts #-}++import Data.List(find,union)+import Data.Maybe(fromJust)+import Test.QuickCheck++import StackSet+import Properties(T, NonNegative)+import XMonad.SwapWorkspaces++-- Ensures that no "loss of information" can happen from a swap.+prop_double_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  t1 `tagMember` ss && t2 `tagMember` ss ==>+  ss == swap (swap ss)+  where swap = swapWorkspaces t1 t2++-- Degrade nicely when given invalid data.+prop_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  not (t1 `tagMember` ss || t2 `tagMember` ss) ==>+  ss == swapWorkspaces t1 t2 ss++-- This doesn't pass yet. Probably should.+-- prop_half_invalid_swap (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+--   t1 `tagMember` ss && not (t2 `tagMember` ss) ==>+--   ss == swapWorkspaces t1 t2 ss++zipWorkspacesWith :: (Workspace i l a -> Workspace i l a -> n) -> StackSet i l a s sd ->+                     StackSet i l a s sd -> [n]+zipWorkspacesWith f s t = f (workspace $ current s) (workspace $ current t) :+                          zipWith f (map workspace $ visible s) (map workspace $ visible t) +++                          zipWith f (hidden s)  (hidden t)++-- Swap only modifies the workspaces tagged t1 and t2 -- leaves all others alone.+prop_swap_only_two (ss :: T) (t1 :: NonNegative Int) (t2 :: NonNegative Int) =+  t1 `tagMember` ss && t2 `tagMember` ss ==>+  and $ zipWorkspacesWith mostlyEqual ss (swapWorkspaces t1 t2 ss)+  where mostlyEqual w1 w2 = map tag [w1, w2] `elem` [[t1, t2], [t2, t1]] || w1 == w2++-- swapWithCurrent stays on current+prop_swap_with_current (ss :: T) (t :: NonNegative Int) =+  t `tagMember` ss ==>+  layout before == layout after && stack before == stack after+  where before = workspace $ current ss+        after  = workspace $ current $ swapWithCurrent t ss++main = do+  putStrLn "Testing double swap"+  quickCheck prop_double_swap+  putStrLn "Testing invalid swap"+  quickCheck prop_invalid_swap+  -- putStrLn "Testing half-invalid swap"+  -- quickCheck prop_half_invalid_swap+  putStrLn "Testing swap only two"+  quickCheck prop_swap_only_two+  putStrLn "Testing swap with current"+  quickCheck prop_swap_with_current
+ tests/test_XPrompt.hs view
@@ -0,0 +1,75 @@+{-# OPTIONS -fglasgow-exts #-}+-------------------------------------+--+-- Tests for XPrompt and ShellPrompt+--+-------------------------------------++import Data.Char+import Test.QuickCheck++import Data.List++import XMonad.XPrompt+import qualified XMonad.ShellPrompt as S+ +instance Arbitrary Char where+    arbitrary     = choose ('\32', '\255')+    coarbitrary c = variant (ord c `rem` 4)+++doubleCheck p = check (defaultConfig { configMaxTest = 1000}) p+deepCheck p = check (defaultConfig { configMaxTest = 10000}) p+deepestCheck p = check (defaultConfig { configMaxTest = 100000}) p++-- brute force check for exceptions+prop_split (str :: [Char]) =+    forAll (elements str) $ \e -> S.split e str == S.split e str++-- check if the first element of the new list is indeed the first part+-- of the string.+prop_spliInSubListsAt (x :: Int) (str :: [Char]) =+    x < length str ==> result == take x str+    where result = case splitInSubListsAt x str of+                     [] -> []+                     x -> head x++-- skipLastWord is complementary to getLastWord, unless the only space+-- in the string is the final character, in which case skipLastWord+-- and getLastWord will produce the same result.+prop_skipGetLastWord (str :: [Char]) =+    skipLastWord str ++ getLastWord str == str || skipLastWord str == getLastWord str++-- newIndex and newCommand get only non empy lists+elemGen :: Gen ([String],String)+elemGen = do+  a <- arbitrary :: Gen [[Char]]+  let l = case filter (/= []) a of+            [] -> ["a"]+            x -> x+  e <- elements l+  return (l,e)++-- newIndex calculates the index of the next completion in the+-- completion list, so the index must be within the range of the+-- copletions list+prop_newIndex_range =+    forAll elemGen $ \(l,c) -> newIndex c l >= 0 &&  newIndex c l < length l++-- this is actually the definition of newCommand...+-- just to check something.+prop_newCommandIndex = +    forAll elemGen $ \(l,c) -> (skipLastWord c ++ (l !! (newIndex c l)))  == newCommand c l++main = do+  putStrLn "Testing ShellPrompt.split"+  deepCheck prop_split+  putStrLn "Testing spliInSubListsAt"+  deepCheck prop_spliInSubListsAt+  putStrLn "Testing newIndex + newCommand"+  deepCheck prop_newCommandIndex+  putStrLn "Testing skip + get lastWord"+  deepCheck prop_skipGetLastWord+  putStrLn "Testing range of XPrompt.newIndex"+  deepCheck prop_newIndex_range+
+ xmonad-contrib.cabal view
@@ -0,0 +1,137 @@+name:               xmonad-contrib+version:            0.5+homepage:           http://xmonad.org/+synopsis:           Third party extensions for xmonad+description:+    Third party tiling algorithms, configurations and scripts to xmonad,+    a tiling window manager for X.+    .+    For an introduction to building, configuring and using xmonad+    extensions, see "XMonad.Doc". In particular:+    .+    "XMonad.Doc.Configuring", a guide to configuring xmonad+    .+    "XMonad.Doc.Extending", using the contributed extensions library+    .+    "XMonad.Doc.Developing", introduction to xmonad internals and writing+    your own extensions.+    .+category:           System+license:            BSD3+license-file:       LICENSE+author:             Spencer Janssen+maintainer:         sjanssen@cse.unl.edu+extra-source-files: README scripts/generate-configs scripts/run-xmonad.sh+                    scripts/xinitrc scripts/xmonad-acpi.c+                    scripts/xmonad-clock.c tests/test_SwapWorkspaces.hs+                    tests/test_XPrompt.hs+cabal-version:      >= 1.2.1++flag small_base+  description: Choose the new smaller, split-up base package.++flag use_xft+  description: Use Xft to render text++library+    if flag(small_base)+        build-depends: base >= 3, containers, directory, process, random+    else+        build-depends: base < 3++    if flag(use_xft)+        build-depends: X11-xft >= 0.2+        cpp-options: -DXFT++    build-depends:      mtl, unix, X11>=1.4.0, xmonad==0.5+    ghc-options:        -Wall -Werror+    exposed-modules:    XMonad.Doc+                        XMonad.Doc.Configuring+                        XMonad.Doc.Extending+                        XMonad.Doc.Developing+                        XMonad.Actions.Commands+                        XMonad.Actions.ConstrainedResize+                        XMonad.Actions.CopyWindow+                        XMonad.Actions.CycleWS+                        XMonad.Actions.DeManage+                        XMonad.Actions.DwmPromote+                        XMonad.Actions.DynamicWorkspaces+                        XMonad.Actions.FindEmptyWorkspace+                        XMonad.Actions.FlexibleManipulate+                        XMonad.Actions.FlexibleResize+                        XMonad.Actions.FloatKeys+                        XMonad.Actions.FocusNth+                        XMonad.Actions.MouseGestures+                        XMonad.Actions.RotSlaves+                        XMonad.Actions.RotView+                        XMonad.Actions.SimpleDate+                        XMonad.Actions.SinkAll+                        XMonad.Actions.Submap+                        XMonad.Actions.SwapWorkspaces+                        XMonad.Actions.TagWindows+                        XMonad.Actions.Warp+                        XMonad.Actions.WindowBringer+                        XMonad.Actions.WmiiActions+                        XMonad.Config.Sjanssen+                        XMonad.Config.Dons+                        XMonad.Config.Arossato+                        XMonad.Config.Droundy+                        XMonad.Hooks.DynamicLog+                        XMonad.Hooks.EwmhDesktops+                        XMonad.Hooks.ManageDocks+                        XMonad.Hooks.SetWMName+                        XMonad.Hooks.UrgencyHook+                        XMonad.Hooks.XPropManage+                        XMonad.Layout.Accordion+                        XMonad.Layout.Circle+                        XMonad.Layout.Combo+                        XMonad.Layout.Dishes+                        XMonad.Layout.DragPane+                        XMonad.Layout.Grid+                        XMonad.Layout.HintedTile+                        XMonad.Layout.LayoutCombinators+                        XMonad.Layout.LayoutHints+                        XMonad.Layout.LayoutModifier+                        XMonad.Layout.LayoutScreens+                        XMonad.Layout.MagicFocus+                        XMonad.Layout.Magnifier+                        XMonad.Layout.Maximize+                        XMonad.Layout.Mosaic+                        XMonad.Layout.MosaicAlt+                        XMonad.Layout.MultiToggle+                        XMonad.Layout.Named+                        XMonad.Layout.NoBorders+                        XMonad.Layout.PerWorkspace+                        XMonad.Layout.ResizableTile+                        XMonad.Layout.Roledex+                        XMonad.Layout.Spiral+                        XMonad.Layout.Square+                        XMonad.Layout.Tabbed+                        XMonad.Layout.ThreeColumns+                        XMonad.Layout.ToggleLayouts+                        XMonad.Layout.TwoPane+                        XMonad.Layout.WindowNavigation+                        XMonad.Layout.WorkspaceDir+                        XMonad.Prompt.Directory+                        XMonad.Prompt+                        XMonad.Prompt.Layout+                        XMonad.Prompt.Man+                        XMonad.Prompt.Shell+                        XMonad.Prompt.Ssh+                        XMonad.Prompt.Window+                        XMonad.Prompt.Workspace+                        XMonad.Prompt.XMonad+                        XMonad.Prompt.AppendFile+                        XMonad.Prompt.Input+                        XMonad.Prompt.Email+                        XMonad.Util.Anneal+                        XMonad.Util.CustomKeys+                        XMonad.Util.Dmenu+                        XMonad.Util.Dzen+                        XMonad.Util.EZConfig+                        XMonad.Util.Font+                        XMonad.Util.Invisible+                        XMonad.Util.NamedWindows+                        XMonad.Util.Run+                        XMonad.Util.XSelection+                        XMonad.Util.XUtils