packages feed

xmonad-contrib-bluetilebranch (empty) → 0.8.1

raw patch · 186 files changed

+25502/−0 lines, 186 filesdep +X11dep +X11-xftdep +basesetup-changed

Dependencies added: X11, X11-xft, base, containers, directory, mtl, old-locale, old-time, process, random, unix, utf8-string, xmonad-bluetilebranch

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/BluetileCommands.hs view
@@ -0,0 +1,60 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.BluetileCommands+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Actions.BluetileCommands (+                             bluetileCommands+                              ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutCombinators+import System.Exit++-- | Generate a list of commands to switch to workspaces (on the given screen).+workspaceCommands :: Int -> X [(String, X ())]+workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return+                            [(("greedyView" ++ show i),+                                activateScreen sid >> windows (W.greedyView i))+                                | i <- spaces ]++layoutCommands :: Int -> [(String, X ())]+layoutCommands sid = [ ("layout floating"    , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Floating"))+                     , ("layout tiled1"      , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Tiled1"))+                     , ("layout tiled2"      , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Tiled2"))+                     , ("layout fullscreen"  , activateScreen sid >>+                                                    sendMessage (JumpToLayout "Fullscreen"))+                     ]++masterAreaCommands :: Int -> [(String, X ())]+masterAreaCommands sid = [ ("increase master n", activateScreen sid >>+                                                    sendMessage (IncMasterN 1))+                         , ("decrease master n", activateScreen sid >>+                                                    sendMessage (IncMasterN (-1)))+                         ]++quitCommands :: [(String, X ())]+quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))+               , ("quit bluetile and start metacity", restart "metacity" False)+               ]++bluetileCommands :: X [(String, X ())]+bluetileCommands = do+    wscmds0 <- workspaceCommands 0+    wscmds1 <- workspaceCommands 1+    return $ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands+                ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands++activateScreen :: Int -> X ()+activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view)
+ 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), commands >>= runCommand)+--+-- and define the list of commands you want to use:+--+-- >    commands :: X [(String, X ())]+-- >    commands = defaultCommands+--+-- Whatever key you bound to will now cause a popup menu of internal+-- xmonad commands to appear.  You can change the commands by changing+-- the contents of the list returned by 'commands'.  (If you like it+-- enough, you may even want to get rid of many of your other key+-- bindings!)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a+--   list of pairs.+commandMap :: [(String, X ())] -> M.Map String (X ())+commandMap c = M.fromList c++-- | Generate a list of commands to switch to\/send windows to workspaces.+workspaceCommands :: X [(String, X ())]+workspaceCommands = asks (workspaces . config) >>= \spaces -> return+                            [((m ++ show i), windows $ f i)+                                | i <- spaces+                                , (f, m) <- [(view, "view"), (shift, "shift")] ]++-- | Generate a list of commands dealing with multiple screens.+screenCommands :: [(String, X ())]+screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))+                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes+                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]+                 ]++-- | A nice pre-defined list of commands.+defaultCommands :: X [(String, X ())]+defaultCommands = do+    wscmds <- workspaceCommands+    return $ wscmds ++ screenCommands ++ otherCommands+ where+    sr = broadcastMessage ReleaseResources+    otherCommands =+        [ ("shrink"              , sendMessage Shrink                               )+        , ("expand"              , sendMessage Expand                               )+        , ("next-layout"         , sendMessage NextLayout                           )+        , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )+        , ("restart-wm"          , sr >> restart "xmonad" True                       )+        , ("restart-wm-no-resume", sr >> restart "xmonad" False                      )+        , ("xterm"               , spawn =<< asks (terminal .  config)              )+        , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )+        , ("kill"                , kill                                             )+        , ("refresh"             , refresh                                          )+        , ("focus-up"            , windows $ focusUp                                )+        , ("focus-down"          , windows $ focusDown                              )+        , ("swap-up"             , windows $ swapUp                                 )+        , ("swap-down"           , windows $ swapDown                               )+        , ("swap-master"         , windows $ swapMaster                             )+        , ("sink"                , withFocused $ windows . sink                     )+        , ("quit-wm"             , io $ exitWith ExitSuccess                        )+        ]++-- | Given a list of command\/action pairs, prompt the user to choose a+--   command and return the corresponding action.+runCommand :: [(String, X ())] -> X ()+runCommand cl = do+  let m = commandMap cl+  choice <- dmenu (M.keys m)+  fromMaybe (return ()) (M.lookup choice m)++-- | Given the name of a command from 'defaultCommands', return the+--   corresponding action (or the null action if the command is not+--   found).+runCommand' :: String -> X ()+runCommand' c = do+  m <- fmap commandMap defaultCommands+  fromMaybe (return ()) (M.lookup c m)
+ XMonad/Actions/ConstrainedResize.hs 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`+                    applySizeHintsContents sh sz)+              (float w)
+ XMonad/Actions/CopyWindow.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CopyWindow+-- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  ???+-- 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, copyToAll, copyWindow, runOrCopy+                                 , killAllOtherCopies, kill1+                                ) where++import Prelude hiding (filter)+import Control.Monad (filterM)+import qualified Data.List as L+import XMonad hiding (modify, workspaces)+import qualified XMonad.StackSet as W++-- $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+--+-- Instead of copying a window from a workset to a workset maybe you don't+-- want to have to remember where you placed it.  For that consider:+--+-- >  , ((modMask x, xK_b    ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox+--+-- Another possibility which this extension provides is 'making window+-- always visible' (i.e. always on current workspace), similar to corresponding+-- metacity functionality. This behaviour is emulated through copying given+-- window to all the workspaces and then removing it when it's unneeded on+-- all workspaces any more.+--+-- Here is the example of keybindings which provide these actions:+--+-- >  , ((modMask x, xK_v ), windows copyToAll) -- @@ Make focused window always visible+-- >  , ((modMask x .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | copy. Copy the focused window to a new workspace.+copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd+copy n s | Just w <- W.peek s = copyWindow w n s+         | otherwise = s++-- | copyToAll. Copy the focused window to all of workspaces.+copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd+copyToAll s = foldr copy s $ map W.tag (W.workspaces s)++-- | copyWindow.  Copy a window to a new workspace+copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd+copyWindow w n = copy'+    where copy' s = if n `W.tagMember` s+                    then W.view (W.currentTag s) $ insertUp' w $ W.view n s+                    else s+          insertUp' a s = W.modify (Just $ W.Stack a [] [])+                          (\(W.Stack t l r) -> if a `elem` t:l++r+                                             then Just $ W.Stack t l r+                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s+++-- | runOrCopy .  runOrCopy will run the provided shell command unless it can+--  find a specified window in which case it will copy the window to+--  the current workspace.  Similar to (i.e., stolen from) "XMonad.Actions.WindowGo".+runOrCopy :: String -> Query Bool -> X ()+runOrCopy = copyMaybe . spawn++-- | copyMaybe. Copies "XMonad.Actions.WindowGo" ('raiseMaybe')+--   TODO: Factor out and improve with regard to WindowGo.+copyMaybe :: X () -> Query Bool -> X ()+copyMaybe f thatUserQuery = withWindowSet $ \s -> do+    maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s)+    case maybeResult of+        []    -> f+        (x:_) -> windows $ copyWindow x (W.currentTag 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 (W.peek ss) $ \w -> if W.member w $ delete'' w ss+                                      then windows $ delete'' w+                                      else kill+    where delete'' w = W.modify Nothing (W.filter (/= w))++-- | Kill all other copies of focused window (if they're present)+-- 'All other' means here 'copies, which are not on current workspace'+--+-- TODO: Call this function after 'copyToAll'?+killAllOtherCopies :: X ()+killAllOtherCopies = do ss <- gets windowset+                        whenJust (W.peek ss) $ \w -> windows $+                                                   W.view (W.currentTag ss) .+                                                   delFromAllButCurrent w+    where+      delFromAllButCurrent w ss = foldr ($) ss $+                                  map (delWinFromWorkspace w . W.tag) $+                                  W.hidden ss ++ map W.workspace (W.visible ss)+      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid
+ XMonad/Actions/CycleRecentWS.hs view
@@ -0,0 +1,85 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CycleRecentWS+-- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Michal Janeczek <janeczek@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides bindings to cycle through most recently used workspaces+-- with repeated presses of a single key (as long as modifier key is+-- held down). This is similar to how many window managers handle+-- window switching.+--+-----------------------------------------------------------------------------++module XMonad.Actions.CycleRecentWS (+                                -- * Usage+                                -- $usage+                                cycleRecentWS,+                                cycleWindowSets+) where++import XMonad hiding (workspaces)+import XMonad.StackSet++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.CycleRecentWS+-- >+-- >   , ((modMask x, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Cycle through most recent workspaces with repeated presses of a key, while+--   a modifier key is held down. The recency of workspaces previewed while browsing+--   to the target workspace is not affected. That way a stack of most recently used+--   workspaces is maintained, similarly to how many window managers handle window+--   switching. For best effects use the same modkey+key combination as the one used+--   to invoke this action.+cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.+                          --   As soon as one of them is released, the final switch is made.+              -> KeySym   -- ^ Key used to switch to next (less recent) workspace.+              -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.+                          --   If it's the same as the nextWorkspace key, it is effectively ignored.+              -> X ()+cycleRecentWS = cycleWindowSets options+ where options w = map (view `flip` w) (recentTags w)+       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]+++cycref :: [a] -> Int -> a+cycref l i = l !! (i `mod` length l)++-- | Cycle through a finite list of WindowSets with repeated presses of a key, while+--   a modifier key is held down. For best effects use the same modkey+key combination+--   as the one used to invoke this action.+cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from+                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.+                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.+                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options+                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.+                                              --   If it's the same as nextOption key, it is effectively ignored.+                -> X ()+cycleWindowSets genOptions mods keyNext keyPrev = do+  options <- gets $ genOptions . windowset+  XConf {theRoot = root, display = d} <- ask+  let event = allocaXEvent $ \p -> do+                maskEvent d (keyPressMask .|. keyReleaseMask) p+                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p+                s <- keycodeToKeysym d c 0+                return (t, s)+  let setOption n = do windows $ const $ options `cycref` n+                       (t, s) <- io event+                       case () of+                         () | t == keyPress   && s == keyNext  -> setOption (n+1)+                            | t == keyPress   && s == keyPrev  -> setOption (n-1)+                            | t == keyRelease && s `elem` mods -> return ()+                            | otherwise                        -> setOption n+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime+  setOption 0+  io $ ungrabKeyboard d currentTime
+ XMonad/Actions/CycleSelectedLayouts.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CycleSelectedLayouts+-- Copyright   :  (c) Roman Cheplyaka+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module allows to cycle through the given subset of layouts.+--+-----------------------------------------------------------------------------++module XMonad.Actions.CycleSelectedLayouts (+    -- * Usage+    -- $usage+    cycleThroughLayouts) where++import XMonad+import Data.List (findIndex)+import Data.Maybe (fromMaybe)+import XMonad.Layout.LayoutCombinators (JumpToLayout(..))+import qualified XMonad.StackSet as S++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+-- +-- > import XMonad hiding ((|||))+-- > import XMonad.Layout.LayoutCombinators ((|||))+-- > import XMonad.Actions.CycleSelectedLayouts+--+-- >   , ((modMask x,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])+--+-- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,+-- rather than the Select defined in xmonad core.++cycleToNext :: (Eq a) => [a] -> a -> Maybe a+cycleToNext lst a = do+    -- not beautiful but simple and readable+    ind <- findIndex (a==) lst+    return $ lst !! if ind == length lst - 1 then 0 else ind+1++-- | If the current layout is in the list, cycle to the next layout. Otherwise,+--   apply the first layout from list.+cycleThroughLayouts :: [String] -> X ()+cycleThroughLayouts lst = do+    winset <- gets windowset+    let ld = description . S.layout . S.workspace . S.current $ winset+    let newld = fromMaybe (head lst) (cycleToNext lst ld)+    sendMessage $ JumpToLayout newld
+ XMonad/Actions/CycleWS.hs view
@@ -0,0 +1,294 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.CycleWS+-- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>,+--                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides bindings to cycle forward or backward through the list of+-- workspaces, to move windows between workspaces, and to cycle+-- between screens.  More general combinators provide ways to cycle+-- through workspaces in various orders, to only cycle through some+-- subset of workspaces, and to cycle by more than one workspace at a+-- time.+--+-- Note that this module now subsumes the functionality of the former+-- @XMonad.Actions.RotView@.  Former users of @rotView@ can simply replace+-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.+--+-- If you want to exactly replicate the action of @rotView@ (cycling+-- through workspace in order lexicographically by tag, instead of in+-- the order specified in the config), it can be implemented as:+--+-- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1+-- >                 windows . greedyView $ t+-- >   where bToDir True  = Next+-- >         bToDir False = Prev+--+-----------------------------------------------------------------------------++module XMonad.Actions.CycleWS (+                                -- * Usage+                                -- $usage++                                -- * Moving between workspaces+                                -- $moving++                                nextWS+                              , prevWS+                              , shiftToNext+                              , shiftToPrev+                              , toggleWS++                                -- * Moving between screens (xinerama)++                              , nextScreen+                              , prevScreen+                              , shiftNextScreen+                              , shiftPrevScreen+                              , swapNextScreen+                              , swapPrevScreen++                                -- * Moving between workspaces, take two!+                                -- $taketwo++                              , WSDirection(..)+                              , WSType(..)++                              , shiftTo+                              , moveTo++                                -- * The mother-combinator++                              , findWorkspace++                             ) where++import Data.List ( findIndex )+import Data.Maybe ( isNothing, isJust )++import XMonad hiding (workspaces)+import XMonad.StackSet hiding (filter)+import XMonad.Util.WorkspaceCompare++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.CycleWS+-- >+-- > -- a basic CycleWS setup+-- >+-- >   , ((modMask x,               xK_Down),  nextWS)+-- >   , ((modMask x,               xK_Up),    prevWS)+-- >   , ((modMask x .|. shiftMask, xK_Down),  shiftToNext)+-- >   , ((modMask x .|. shiftMask, xK_Up),    shiftToPrev)+-- >   , ((modMask x,               xK_Right), nextScreen)+-- >   , ((modMask x,               xK_Left),  prevScreen)+-- >   , ((modMask x .|. shiftMask, xK_Right), shiftNextScreen)+-- >   , ((modMask x .|. shiftMask, xK_Left),  shiftPrevScreen)+-- >   , ((modMask x,               xK_z),     toggleWS)+--+-- If you want to follow the moved window, you can use both actions:+--+-- >   , ((modMask x .|. shiftMask, xK_Down), shiftToNext >> nextWS)+-- >   , ((modMask x .|. shiftMask, xK_Up),   shiftToPrev >> prevWS)+--+-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.+-- For example:+--+-- >   , ((modMask x     , xK_f), moveTo Next EmptyWS)  -- find a free workspace+-- >   , ((modMask x .|. controlMask, xK_Right),        -- a crazy keybinding!+-- >         do t <- findWorkspace getXineramaWsCompare Next NonEmptyWS 2+-- >            windows . view $ t                                         )+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++{- $moving++The following commands for moving the view and windows between+workspaces are somewhat inflexible, but are very simple and probably+Do The Right Thing for most users.++All of the commands in this section cycle through workspaces in the+order in which they are given in your config.++-}++-- | Switch to the next workspace.+nextWS :: X ()+nextWS = switchWorkspace 1++-- | Switch to the previous workspace.+prevWS :: X ()+prevWS = switchWorkspace (-1)++-- | Move the focused window to the next workspace.+shiftToNext :: X ()+shiftToNext = shiftBy 1++-- | Move the focused window to the previous workspace.+shiftToPrev :: X ()+shiftToPrev = shiftBy (-1)++-- | Toggle to the workspace displayed previously.+toggleWS :: X ()+toggleWS = windows $ view =<< tag . head . hidden++switchWorkspace :: Int -> X ()+switchWorkspace d = wsBy d >>= windows . greedyView++shiftBy :: Int -> X ()+shiftBy d = wsBy d >>= windows . shift++wsBy :: Int -> X (WorkspaceId)+wsBy = findWorkspace getSortByIndex Next AnyWS++{- $taketwo++A few more general commands are also provided, which allow cycling+through subsets of workspaces.++For example,++>   moveTo Next EmptyWS++will move to the first available workspace with no windows, and++>   shiftTo Prev (WSIs $ return (('p' `elem`) . tag))++will move the focused window backwards to the first workspace containing+the letter 'p' in its name. =)++-}++-- | Direction to cycle through the sort order.+data WSDirection = Next | Prev++-- | What type of workspaces should be included in the cycle?+data WSType = EmptyWS     -- ^ cycle through empty workspaces+            | NonEmptyWS  -- ^ cycle through non-empty workspaces+            | HiddenWS    -- ^ cycle through non-visible workspaces+            | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces+            | AnyWS       -- ^ cycle through all workspaces+            | WSIs (X (WindowSpace -> Bool))+                          -- ^ cycle through workspaces satisfying+                          --   an arbitrary predicate++-- | Convert a WSType value to a predicate on workspaces.+wsTypeToPred :: WSType -> X (WindowSpace -> Bool)+wsTypeToPred EmptyWS    = return (isNothing . stack)+wsTypeToPred NonEmptyWS = return (isJust . stack)+wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)+                             return (\w -> tag w `elem` hs)+wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS+                                    hi <- wsTypeToPred HiddenWS+                                    return (\w -> hi w && ne w)+wsTypeToPred AnyWS      = return (const True)+wsTypeToPred (WSIs p)   = p++-- | View the next workspace in the given direction that satisfies+--   the given condition.+moveTo :: WSDirection -> WSType -> X ()+moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView++-- | Move the currently focused window to the next workspace in the+--   given direction that satisfies the given condition.+shiftTo :: WSDirection -> WSType -> X ()+shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift++-- | Given a function @s@ to sort workspaces, a direction @dir@, a+--   predicate @p@ on workspaces, and an integer @n@, find the tag of+--   the workspace which is @n@ away from the current workspace in+--   direction @dir@ (wrapping around if necessary), among those+--   workspaces, sorted by @s@, which satisfy @p@.+--+--   For some useful workspace sorting functions, see+--   "XMonad.Util.WorkspaceCompare".+--+--   For ideas of what to do with a workspace tag once obtained, note+--   that 'moveTo' and 'shiftTo' are implemented by applying @(>>=+--   (windows . greedyView))@ and @(>>= (windows . shift))@, respectively,+--   to the output of 'findWorkspace'.+findWorkspace :: X WorkspaceSort -> WSDirection -> WSType -> Int -> X WorkspaceId+findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)+  where+    maybeNegate Next d = d+    maybeNegate Prev d = (-d)++findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId+findWorkspaceGen _ _ 0 = gets (currentTag . windowset)+findWorkspaceGen sortX wsPredX d = do+    wsPred <- wsPredX+    sort   <- sortX+    ws     <- gets windowset+    let cur     = workspace (current ws)+        sorted  = sort (workspaces ws)+        pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a+        ws'     = filter wsPred $ pivoted+        mCurIx  = findWsIndex cur ws'+        d'      = if d > 0 then d - 1 else d+        next    = if null ws'+                      then cur+                      else case mCurIx of+                            Nothing -> ws' !! (d' `mod` length ws')+                            Just ix -> ws' !! ((ix + d) `mod` length ws')+    return $ tag next++findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int+findWsIndex ws wss = findIndex ((== tag ws) . tag) wss++-- | View next screen+nextScreen :: X ()+nextScreen = switchScreen 1++-- | View prev screen+prevScreen :: X ()+prevScreen = switchScreen (-1)++switchScreen :: Int -> X ()+switchScreen d = do s <- screenBy d+                    mws <- screenWorkspace s+                    case mws of+                         Nothing -> return ()+                         Just ws -> windows (view ws)++screenBy :: Int -> X (ScreenId)+screenBy d = do ws <- gets windowset+                --let ss = sortBy screen (screens ws)+                let now = screen (current ws)+                return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws))++-- | Swap current screen with next screen+swapNextScreen :: X ()+swapNextScreen = swapScreen 1++-- | Swap current screen with previous screen+swapPrevScreen :: X ()+swapPrevScreen = swapScreen (-1)++swapScreen :: Int -> X ()+swapScreen d = do s <- screenBy d+                  mws <- screenWorkspace s+                  case mws of+                    Nothing -> return ()+                    Just ws -> windows (greedyView ws)++-- | Move focused window to workspace on next screen+shiftNextScreen :: X ()+shiftNextScreen = shiftScreenBy 1++-- | Move focused window to workspace on prev screen+shiftPrevScreen :: X ()+shiftPrevScreen = shiftScreenBy (-1)++shiftScreenBy :: Int -> X ()+shiftScreenBy d = do s <- screenBy d+                     mws <- screenWorkspace s+                     case mws of+                         Nothing -> return ()+                         Just ws -> windows (shift ws)
+ XMonad/Actions/CycleWindows.hs view
@@ -0,0 +1,222 @@+--------------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.CycleWindows+-- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com>+-- License      : BSD3-style (see LICENSE)+--+-- Maintainer   : Wirt Wolff <wirtwolff@gmail.com>+-- Stability    : unstable+-- Portability  : unportable+--+-- Provides bindings to cycle windows up or down on the current workspace+-- stack while maintaining focus in place. Bindings are available to:+--+-- * Cycle nearby or nth windows into the focused frame+--+-- * Cycle a window halfway around the stack+--+-- * Cycle windows through the focused position.+--+-- * Cycle unfocused windows.+-- +-- These bindings are especially useful with layouts that hide some of+-- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or+-- "XMonad.Layout.Mosaic" with three or four panes. See also+-- "XMonad.Actions.RotSlaves" for related actions.+-----------------------------------------------------------------------------+module XMonad.Actions.CycleWindows (+        -- * Usage+        -- $usage++        -- * Cycling nearby or nth window into current frame+        -- $cycle+        cycleRecentWindows,+        cycleStacks',+        -- * Cycling half the stack to get rid of a boring window+        -- $opposite+        rotOpposite', rotOpposite,+        -- * Cycling windows through the current frame+        -- $focused+        rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus',+        -- * Cycling windows through other frames+        -- $unfocused+        rotUnfocused', rotUnfocusedUp, rotUnfocusedDown,+        -- * Updating the mouse pointer+        -- $pointer++        -- * Generic list rotations+        -- $generic+        rotUp, rotDown+) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Actions.RotSlaves++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.CycleWindows+-- >    -- config+-- >    -- other key bindings with x here your config+-- >+-- >              -- make sure mod matches keysym+-- >  , ((mod4Mask,  xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w)+-- >  , ((modMask x, xK_z), rotOpposite)+-- >  , ((modMask x                , xK_i), rotUnfocusedUp)+-- >  , ((modMask x                , xK_u), rotUnfocusedDown)+-- >  , ((modMask x .|. controlMask, xK_i), rotFocusedUp)+-- >  , ((modMask x .|. controlMask, xK_u), rotFocusedDown)+--+-- Also, if you use focus follows mouse, you will want to read the section+-- on updating the mouse pointer below.  For detailed instructions on+-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings". +{- $pointer+With FocusFollowsMouse == True, the focus is updated after binding+actions, possibly focusing a window you didn't intend to focus. Most+people using TwoPane probably already have a logHook causing the mouse+to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp")++If you want this built into the key binding instead, use the appropriate+action from one of those modules to also have your bindings move the pointer+to the point of your choice on the current window:++> import XMonad.Actions.UpdatePointer -- or Actions.Warp++and either++> -- modify the window rotation bindings+> , ((modMask x .|. controlMask, xK_i   ), rotFocusedUp+>                                            >> updatePointer (Relative 1 1))+> , ((modMask x .|. controlMask, xK_u   ), rotFocusedDown+>                                            >> updatePointer (Relative 1 1))+>+>    -- or add to xmonad's logHook+>    , logHook = dynamicLogWithPP xmobarPP+>                    >> updatePointer Nearest -- or your preference++-}++-- $cycle+-- Cycle windows into focus from below or above the focused pane by pressing+-- a key while one or more modifier keys is held down. The window order isn't+-- changed until a modifier is released, leaving the previously focused window+-- just below the new one, (or above if the window just above is chosen.) For+-- best results use the same modifier + key combination as the one used to invoke+-- the \"bring from below\" action.  Also, once cycling, pressing a number key n+-- will focus the nth window, with 0 being the one originally focused.+cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking this action.+                               --   As soon as one of them is released, the final switch is made.+                    -> KeySym  -- ^ Key used to shift windows from below the current choice into the current frame.+                    -> KeySym  -- ^ Key used to shift windows from above the current choice into the current frame.+                               --   If it's the same as the first key, it is effectively ignored.+                    -> X ()+cycleRecentWindows = cycleStacks' stacks where+    stacks s = map (shiftToFocus' `flip` s) (wins s)+    wins (W.Stack t l r) = t : r ++ reverse l+++-- | Cycle through a /finite/ list of window stacks with repeated presses+--   of a key while a modifier key is held down. For best results use the same+--   mod key + key combination as the one used to invoke the \"bring from below\"+--   action. You could use cycleStacks' with a different stack permutations+--   function to, for example, cycle from one below to one above to two below,+--   etc. instead of in order. You are responsible for having it generate a+--   finite list, though, or xmonad may hang seeking its length.+cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack.+                                    -> [KeySym]  -- ^ A list of modifier keys used to invoke 'cycleStacks''.+                                                 --   As soon as any is released, we're no longer cycling on the [Stack Window]+                                    -> KeySym    -- ^ Key used to select a \"next\" stack.+                                    -> KeySym    -- ^ Key used to select a \"previous\" stack.+                                    -> X ()+cycleStacks' filteredPerms mods keyNext keyPrev = do+    XConf {theRoot = root, display = d} <- ask+    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset++    let evt = allocaXEvent $+                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p+                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p+                           s <- keycodeToKeysym d c 0+                           return (t, s)+        choose n (t, s)+              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)+              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)+              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)+              | t == keyRelease && s `elem` mods = return ()+              | otherwise                        = doStack n >> io evt >>= choose n+        doStack n = windows . W.modify' . const $ stacks `cycref` n++    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime+    io evt >>= choose 1+    io $ ungrabKeyboard d currentTime+  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite+        numKeyToN = subtract 48 . read . show++-- | Given a stack element and a stack, shift or insert the element (window)+--   at the currently focused position.+shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a+shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs'+  where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s+++-- $opposite+-- Shifts the focused window as far as possible from the current focus,+-- i.e. halfway around the stack. Windows above the focus up to the \"opposite\"+-- position remain in place, while those above the insertion shift toward+-- the current focus. This is useful for people who use lots of windows in Full,+-- TwoPane, etc., to get rid of boring windows while cycling and swapping+-- near the focus.+rotOpposite :: X()+rotOpposite = windows $ W.modify' rotOpposite'++-- | The opposite rotation on a Stack.+rotOpposite' :: W.Stack a -> W.Stack a+rotOpposite' (W.Stack t l r) = W.Stack t' l' r'+  where rrvl = r ++ reverse l+        part = (length rrvl + 1) `div` 2+        (l',t':r') = (\(f,s) -> (f, reverse s)) . splitAt (length l) $+                                reverse (take part rrvl ++ t : drop part rrvl)+++-- $focused+-- Rotate windows through the focused frame, excluding the \"next\" window.+-- With, e.g. TwoPane, this allows cycling windows through either the+-- master or slave pane, without changing the other frame. When the master+-- is focused, the window below is skipped, when a non-master window is+-- focused, the master is skipped.+rotFocusedUp :: X ()+rotFocusedUp = windows . W.modify' $ rotFocused' rotUp+rotFocusedDown :: X ()+rotFocusedDown = windows . W.modify' $ rotFocused' rotDown++-- | The focused rotation on a stack.+rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a+rotFocused' _ s@(W.Stack _ [] []) = s+rotFocused' f   (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus+    where (t':rs') = f (t:rs)+rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s              -- otherwise+++-- $unfocused+-- Rotate windows through the unfocused frames. This is similar to+-- rotSlaves, from "XMonad.Actions.RotSlaves", but excludes the current+-- frame rather than master.+rotUnfocusedUp :: X ()+rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp+rotUnfocusedDown :: X ()+rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown++-- | The unfocused rotation on a stack.+rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a+rotUnfocused' _ s@(W.Stack _ [] []) = s+rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s                 -- Master has focus+rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise+    where  (master:revls)  = reverse ls+           (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)++-- $generic+-- Generic list rotations+rotUp :: [a] -> [a]+rotUp   l = tail l ++ [head l]+rotDown :: [a] -> [a]+rotDown l = last l : init l
+ XMonad/Actions/DeManage.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DeManage+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- 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,132 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.DynamicWorkspaces+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- 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,+                                         addHiddenWorkspace,+                                         withWorkspace,+                                         selectWorkspace, renameWorkspace,+                                         toNthWorkspace, withNthWorkspace+                                       ) where++import XMonad hiding (workspaces)+import XMonad.StackSet hiding (filter, modify, delete)+import XMonad.Prompt.Workspace+import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )+import XMonad.Util.WorkspaceCompare ( getSortByIndex )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.DynamicWorkspaces+--+-- Then add keybindings like the following:+--+-- >   , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)+-- >   , ((modMask x .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)+-- >   , ((modMask x, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))+-- >   , ((modMask x .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))+-- >   , ((modMask x .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)+--+-- > -- mod-[1..9]       %! Switch to workspace N+-- > -- mod-shift-[1..9] %! Move client to workspace N+-- >    +++-- >    zip (zip (repeat (modMask x)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])+-- >    +++-- >    zip (zip (repeat (modMask x .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++data Wor = Wor String++instance XPrompt Wor where+    showXPrompt (Wor x) = x++mkCompl :: [String] -> String -> IO [String]+mkCompl l s = return $ filter (\x -> take (length s) x == s) l++withWorkspace :: XPConfig -> (String -> X ()) -> X ()+withWorkspace c job = do ws <- gets (workspaces . windowset)+                         sort <- getSortByIndex+                         let ts = map tag $ sort ws+                             job' t | t `elem` ts = job t+                                    | otherwise = addHiddenWorkspace t >> job t+                         mkXPrompt (Wor "") c (mkCompl ts) job'++renameWorkspace :: XPConfig -> X ()+renameWorkspace conf = workspacePrompt conf $ \w ->+                       windows $ \s -> let sett wk = wk { tag = w }+                                           setscr scr = scr { workspace = sett $ workspace scr }+                                           sets q = q { current = setscr $ current q }+                                       in sets $ removeWorkspace' w s++toNthWorkspace :: (String -> X ()) -> Int -> X ()+toNthWorkspace job wnum = do sort <- getSortByIndex+                             ws <- gets (map tag . sort . workspaces . windowset)+                             case drop wnum ws of+                               (w:_) -> job w+                               [] -> return ()++withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()+withNthWorkspace job wnum = do sort <- getSortByIndex+                               ws <- gets (map tag . sort . workspaces . windowset)+                               case drop wnum ws of+                                 (w:_) -> windows $ job w+                                 [] -> return ()++selectWorkspace :: XPConfig -> X ()+selectWorkspace conf = workspacePrompt conf $ \w ->+                       do s <- gets windowset+                          if tagMember w s+                            then windows $ greedyView w+                            else addWorkspace w++-- | Add a new workspace with the given name.+addWorkspace :: String -> X ()+addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)+++-- | Add a new hidden workspace with the given name.+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 = applySizeHintsContents 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` applySizeHintsContents 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) = applySizeHintsContents 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) = applySizeHintsContents 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,50 @@+-----------------------------------------------------------------------------+-- |+-- 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/GridSelect.hs view
@@ -0,0 +1,398 @@+{-# LANGUAGE ScopedTypeVariables #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.GridSelect+-- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Clemens Fruhwirth <clemens@endorphin.org>+-- Stability   :  unstable+-- Portability :  unportable+--+-- GridSelect displays items(e.g. the opened windows) in a 2D grid and lets+-- the user select from it with the cursor/hjkl keys or the mouse.+--+-----------------------------------------------------------------------------++module XMonad.Actions.GridSelect (+    -- * Usage+    -- $usage+    GSConfig(..),+    defaultGSConfig,+    defaultGSSpawnConfig,+    buildDefaultGSConfig,+    gridselect,+    gridselectWindow,+    withSelectedWindow,+    bringSelected,+    goToSelected,+    spawnSelected,+    runSelectedAction,+    fromClassName,+    defaultColorizer,+    colorRangeFromClassName+    ) where+import Data.Maybe+import Data.Bits+import Control.Monad.State+import Control.Arrow+import Data.List as L+import XMonad+import XMonad.Util.Font+import XMonad.Prompt (mkUnmanagedWindow)+import XMonad.StackSet as W+import XMonad.Layout.DecorationUtils+import XMonad.Util.NamedWindows+import XMonad.Actions.WindowBringer (bringWindow)+import Text.Printf+import System.Random (mkStdGen, genRange, next)+import Data.Word (Word8)++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.GridSelect+--+-- Then add a keybinding, e.g.+--+-- >    , ((modMask x, xK_g), goToSelected defaultGSConfig)+--+-- Screenshot: <http://clemens.endorphin.org/gridselect.png>+--+-- This module also supports displaying arbitrary information in a grid and letting+-- the user select from it. E.g. to spawn an application from a given list, you+-- can use the following:+--+-- >   , ((modMask x, xK_s), spawnSelected defaultGSSpawnConfig ["xterm","gmplayer","gvim"])++data GSConfig a = GSConfig {+      gs_cellheight :: Integer,+      gs_cellwidth :: Integer,+      gs_cellpadding :: Integer,+      gs_colorizer :: a -> Bool -> X (String, String),+      gs_font :: String,+      gs_originFractX :: Double,+      gs_originFractY :: Double+}++type TwoDPosition = (Integer, Integer)++type TwoDElementMap a = [(TwoDPosition,(String,a))]++data TwoDState a = TwoDState { td_curpos :: TwoDPosition+                             , td_elementmap :: TwoDElementMap a+                             , td_gsconfig :: GSConfig a+                             , td_font :: XMonadFont+                             , td_paneX :: Integer+                             , td_paneY :: Integer+                             , td_drawingWin :: Window+                             }++type TwoD a b = StateT (TwoDState a) X b++diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]+-- FIXME remove nub+diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]+        in nub $ ul ++ (map (negate *** id) ul) +++           (map (negate *** negate) ul) +++           (map (id *** negate) ul)++diamond :: (Enum a, Num a) => [(a, a)]+diamond = concatMap diamondLayer [0..]++diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]+diamondRestrict x y originX originY =+  L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .+  map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .+  take 1000 $ diamond++tupadd :: (Num t1, Num t) => (t, t1) -> (t, t1) -> (t, t1)+tupadd (a,b) (c,d) = (a+c,b+d)++findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)+findInElementMap pos = find ((== pos) . fst)++drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()+drawWinBox win font (fg,bg) ch cw text x y cp =+  withDisplay $ \dpy -> do+  gc <- liftIO $ createGC dpy win+  bordergc <- liftIO $ createGC dpy win+  liftIO $ do+    Just fgcolor <- initColor dpy fg+    Just bgcolor <- initColor dpy bg+    Just bordercolor <- initColor dpy borderColor+    setForeground dpy gc fgcolor+    setBackground dpy gc bgcolor+    setForeground dpy bordergc bordercolor+    fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)+    drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)+  stext <- shrinkWhile (shrinkIt shrinkText)+           (\n -> do size <- liftIO $ textWidthXMF dpy font n+                     return $ size > (fromInteger (cw-(2*cp))))+           text+  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext+  liftIO $ freeGC dpy gc+  liftIO $ freeGC dpy bordergc++updateAllElements :: TwoD a ()+updateAllElements =+    do+      TwoDState { td_elementmap = els } <- get+      updateElements els++updateElements :: TwoDElementMap a -> TwoD a ()+updateElements elementmap = do+    TwoDState { td_curpos = curpos,+                td_drawingWin = win,+                td_gsconfig = gsconfig,+                td_font = font,+                td_paneX = paneX,+                td_paneY = paneY} <- get+    let cellwidth = gs_cellwidth gsconfig+        cellheight = gs_cellheight gsconfig+        paneX' = div (paneX-cellwidth) 2+        paneY' = div (paneY-cellheight) 2+        updateElement (pos@(x,y),(text, element)) = lift $ do+            colors <- (gs_colorizer gsconfig) element (pos == curpos)+            drawWinBox win font+                       colors+                       cellheight+                       cellwidth+                       text+                       (paneX'+x*cellwidth)+                       (paneY'+y*cellheight)+                       (gs_cellpadding gsconfig)+    mapM updateElement elementmap+    return ()++eventLoop :: TwoD a (Maybe a)+eventLoop = do+  (keysym,string,event) <- lift $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do+                             nextEvent d e+                             ev <- getEvent e+                             (ks,s) <- if ev_event_type ev == keyPress+                                       then lookupString $ asKeyEvent e+                                       else return (Nothing, "")+                             return (ks,s,ev)+  handle (fromMaybe xK_VoidSymbol keysym,string) event++handle :: (KeySym, String)+       -> Event+       -> StateT (TwoDState a) X (Maybe a)+handle (ks,_) (KeyEvent {ev_event_type = t})+    | t == keyPress && ks == xK_Escape = return Nothing+    | t == keyPress && (ks == xK_Left || ks == xK_h)  = diffAndRefresh (-1,0)+    | t == keyPress && (ks == xK_Right || ks == xK_l) = diffAndRefresh (1,0)+    | t == keyPress && (ks == xK_Down || ks == xK_j) = diffAndRefresh (0,1)+    | t == keyPress && (ks == xK_Up || ks == xK_k) = diffAndRefresh (0,-1)+    | t == keyPress && ks == xK_Return = do+       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get+       return $ fmap (snd . snd) $ findInElementMap pos elmap+  where diffAndRefresh diff = do+          state <- get+          let elmap = td_elementmap state+              oldPos = td_curpos state+              newPos = oldPos `tupadd` diff+              newSelectedEl = findInElementMap newPos elmap+          when (isJust newSelectedEl) $ do+                                put state { td_curpos =  newPos }+                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])+          eventLoop++handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })+    | t == buttonRelease = do+        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,+                     td_gsconfig = (GSConfig ch cw _ _ _ _ _) }) <- get+        let gridX = (fi x - (px - cw) `div` 2) `div` cw+            gridY = (fi y - (py - ch) `div` 2) `div` ch+        case lookup (gridX,gridY) elmap of+             Just (_,el) -> return (Just el)+             Nothing -> eventLoop+    | otherwise = eventLoop++handle _ (ExposeEvent { }) = updateAllElements >> eventLoop++handle _ _ = eventLoop++-- FIXME probably move that into Utils?+-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space+hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)+hsv2rgb (h,s,v) =+    let hi = (div h 60) `mod` 6 :: Integer+        f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a+        q = v * (1-f)+        p = v * (1-s)+        t = v * (1-(1-f)*s)+    in case hi of+         0 -> (v,t,p)+         1 -> (q,v,p)+         2 -> (p,v,t)+         3 -> (p,q,v)+         4 -> (t,p,v)+         5 -> (v,p,q)+         _ -> error "The world is ending. x mod a >= a."++-- | Default colorizer for Strings+defaultColorizer :: String -> Bool -> X (String, String)+defaultColorizer s active = +    let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer+        (r,g,b) = hsv2rgb ((seed 83) `mod` 360,+                           (fromInteger ((seed 191) `mod` 1000))/2500+0.4,+                           (fromInteger ((seed 121) `mod` 1000))/2500+0.4)+    in if active+         then return ("#faff69", "black")+         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")++-- | Colorize a window depending on it's className.+fromClassName :: Window -> Bool -> X (String, String)+fromClassName w active = runQuery className w >>= flip defaultColorizer active++twodigitHex :: Word8 -> String+twodigitHex a = printf "%02x" a++-- | A colorizer that picks a color inside a range,+-- and depending on the window's class.+colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range+                        -> (Word8, Word8, Word8) -- ^ End of the color range+                        -> (Word8, Word8, Word8) -- ^ Background of the active window+                        -> (Word8, Word8, Word8) -- ^ Inactive text color+                        -> (Word8, Word8, Word8) -- ^ Active text color+                        -> Window -> Bool -> X (String, String)+colorRangeFromClassName startC endC activeC inactiveT activeT w active = +    do classname <- runQuery className w+       if active +         then return (rgbToHex activeC, rgbToHex activeT)+         else return (rgbToHex $ mix startC endC +                  $ stringToRatio classname, rgbToHex inactiveT)+    where rgbToHex :: (Word8, Word8, Word8) -> String+          rgbToHex (r, g, b) = '#':twodigitHex r+                               ++twodigitHex g++twodigitHex b++-- | Creates a mix of two colors according to a ratio +-- (1 -> first color, 0 -> second color).+mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)+        -> Double -> (Word8, Word8, Word8)+mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2)+    where  mix' a b = truncate $ (fi a * r) + (fi b * (1 - r))++-- | Generates a Double from a string, trying to+-- achieve a random distribution.+-- We create a random seed from the sum of all characters+-- in the string, and use it to generate a ratio between 0 and 1+stringToRatio :: String -> Double+stringToRatio "" = 0+stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s+                      range = (\(a, b) -> b - a) $ genRange gen+                      randomInt = foldr1 combine $ replicate 20 next+                      combine f1 f2 g = let (_, g') = f1 g in f2 g'+                  in fi (fst $ randomInt gen) / fi range++-- | Brings up a 2D grid of elements in the center of the screen, and one can+-- select an element with cursors keys. The selected element is returned.+gridselect :: forall a . GSConfig a -> [(String,a)] -> X (Maybe a)+gridselect gsconfig elmap =+ withDisplay $ \dpy -> do+    rootw <- asks theRoot+    s <- gets $ screenRect . W.screenDetail . W.current . windowset+    win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw+                    (rect_x s) (rect_y s) (rect_width s) (rect_height s)+    liftIO $ mapWindow dpy win+    liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)+    status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime+    io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none+    font <- initXMF (gs_font gsconfig)+    let screenWidth = toInteger $ rect_width s;+        screenHeight = toInteger $ rect_height s;+    selectedElement <- if (status == grabSuccess) then+                          do+                            let restriction :: Integer -> (GSConfig a -> Integer) -> Double+                                restriction ss cs = ((fromInteger ss)/(fromInteger $ cs gsconfig)-1)/2+                                restrictX = floor $ restriction screenWidth gs_cellwidth+                                restrictY = floor $ restriction screenHeight gs_cellheight+                                originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX+                                originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY+                                coords = diamondRestrict restrictX restrictY originPosX originPosY+                                elmap' = zip coords elmap+                            selectedElement <- evalStateT (updateAllElements >> eventLoop)+                                                          (TwoDState (head coords)+                                                           elmap'+                                                           gsconfig+                                                           font+                                                           screenWidth+                                                           screenHeight+                                                           win)+                            return selectedElement+                      else+                          return Nothing+    liftIO $ do+      unmapWindow dpy win+      destroyWindow dpy win+      sync dpy False+    releaseXMF font+    return selectedElement++-- | Like `gridSelect' but with the current windows and their titles as elements+gridselectWindow :: GSConfig Window -> X (Maybe Window)+gridselectWindow gsconf = windowMap >>= gridselect gsconf++-- | Brings up a 2D grid of windows in the center of the screen, and one can+-- select a window with cursors keys. The selected window is then passed to+-- a callback function.+withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()+withSelectedWindow callback conf = do+    mbWindow <- gridselectWindow conf+    case mbWindow of+        Just w -> callback w+        Nothing -> return ()++windowMap :: X [(String,Window)]+windowMap = do+    ws <- gets windowset+    wins <- mapM keyValuePair (W.allWindows ws)+    return wins+ where keyValuePair w = flip (,) w `fmap` decorateName' w++decorateName' :: Window -> X String+decorateName' w = do+  fmap show $ getName w++defaultGSConfig :: GSConfig Window+defaultGSConfig = buildDefaultGSConfig fromClassName++-- | Builds a default gs config from a colorizer function.+buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" (1/2) (1/2)++borderColor :: String+borderColor = "white"++-- | Brings selected window to the current workspace.+bringSelected :: GSConfig Window -> X ()+bringSelected = withSelectedWindow $ \w -> do+    windows (bringWindow w)+    XMonad.focus w+    windows W.shiftMaster++-- | Switches to selected window's workspace and focuses that window.+goToSelected :: GSConfig Window -> X ()+goToSelected = withSelectedWindow $ windows . W.focusWindow++defaultGSSpawnConfig :: GSConfig String+defaultGSSpawnConfig = buildDefaultGSConfig defaultColorizer++-- | Select an application to spawn from a given list+spawnSelected :: GSConfig String -> [String] -> X ()+spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn++-- | Select an action and run it in the X monad+runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()+runSelectedAction conf actions = do+    selectedActionM <- gridselect conf actions+    case selectedActionM of+        Just selectedAction -> selectedAction+        Nothing -> return ()++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
+ XMonad/Actions/MessageFeedback.hs view
@@ -0,0 +1,99 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.MessageFeedback+-- Copyright    : (c) Quentin Moser <quentin.moser@unifr.ch>+-- License      : BSD3+--+-- Maintainer   : None+-- Stability    : unstable+-- Portability  : unportable+--+-- Alternative to 'XMonad.Operations.sendMessage' that provides knowledge+-- of whether the message was handled, and utility functions based on+-- this facility.+-----------------------------------------------------------------------------++module XMonad.Actions.MessageFeedback (+                                      -- * Usage+                                      -- $usage++                                        send+                                      , tryMessage+                                      , tryMessage_+                                      , tryInOrder+                                      , tryInOrder_+                                      , sm+                                      , sendSM+                                      , sendSM_+                                      ) where++import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )+import XMonad.StackSet ( current, workspace, layout, tag )+import XMonad.Operations ( updateLayout )++import Control.Monad.State ( gets )+import Data.Maybe ( isJust )+import Control.Applicative ((<$>))++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.MessageFeedback+--+-- You can then use this module's functions wherever an action is expected.+--+-- Note that most functions in this module have a return type of @X Bool@+-- whereas configuration options will expect a @X ()@ action.+-- For example, the key binding+--+-- > -- Shrink the master area of a tiled layout, or move the focused window+-- > -- to the left in a WindowArranger-based layout+-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))+--+-- is mis-typed. For this reason, this module provides alternatives (ending with+-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.+-- For example, to correct the previous example: +-- +-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))+--+++-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the+-- message was handled by the layout, False otherwise.+send :: Message a => a -> X Bool+send = sendSM . sm++-- | Sends the first message, and if it was not handled, sends the second.+-- Returns True if either message was handled, False otherwise.+tryMessage :: (Message a, Message b) => a -> b -> X Bool+tryMessage m1 m2 = do b <- send m1+                      if b then return True else send m2++tryMessage_ :: (Message a, Message b) => a -> b -> X ()+tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()++-- | Tries sending every message of the list in order until one of them+-- is handled. Returns True if one of the messages was handled, False otherwise.+tryInOrder :: [SomeMessage] -> X Bool+tryInOrder [] = return False+tryInOrder (m:ms) = do b <- sendSM m+                       if b then return True else tryInOrder ms++tryInOrder_ :: [SomeMessage] -> X ()+tryInOrder_ ms = tryInOrder ms >> return ()+++-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.+sm :: Message a => a -> SomeMessage+sm = SomeMessage+++sendSM :: SomeMessage -> X Bool+sendSM m = do w <- workspace . current <$> gets windowset+              ml' <- handleMessage (layout w) m `catchX` return Nothing+              updateLayout (tag w) ml'+              return $ isJust ml'+++sendSM_ :: SomeMessage -> X ()+sendSM_ m = sendSM m >> return ()
+ XMonad/Actions/MouseGestures.hs view
@@ -0,0 +1,137 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.MouseGestures+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Support for simple mouse gestures.+--+-----------------------------------------------------------------------------++module XMonad.Actions.MouseGestures (+    -- * Usage+    -- $usage+    Direction(..),+    mouseGestureH,+    mouseGesture,+    mkCollect+) where++import XMonad+import XMonad.Hooks.ManageDocks (Direction(..))++import Data.IORef+import qualified Data.Map as M+import Data.Map (Map)+import Data.Maybe+import Control.Monad++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.MouseGestures+-- > import qualified XMonad.StackSet as W+--+-- then add an appropriate mouse binding:+--+-- >     , ((modMask x .|. shiftMask, button3), mouseGesture gestures)+--+-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on+-- windows, for example:+--+-- >     gestures = M.fromList+-- >         [ ([], focus)+-- >         , ([U], \w -> focus w >> windows W.swapUp)+-- >         , ([D], \w -> focus w >> windows W.swapDown)+-- >         , ([R, D], \_ -> sendMessage NextLayout)+-- >         ]+--+-- This is just an example, of course; you can use any mouse button and+-- gesture definitions you want.+--+-- For detailed instructions on editing your mouse bindings, see+-- "XMonad.Doc.Extending#Editing_mouse_bindings".++type Pos = (Position, Position)++delta :: Pos -> Pos -> Position+delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)+    where+    d a b = abs (a - b)++dir :: Pos -> Pos -> Direction+dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)+    where+    trans :: Double -> Direction+    trans x+        | rg (-3/4) (-1/4) x = D+        | rg (-1/4)  (1/4) x = R+        | rg  (1/4)  (3/4) x = U+        | otherwise          = L+    rg a z x = a <= x && x < z++gauge :: (Direction -> X ()) -> Pos -> IORef (Maybe (Direction, Pos)) -> Position -> Position -> X ()+gauge hook op st nx ny = do+    let np = (nx, ny)+    stx <- io $ readIORef st+    let+        (~(Just od), pivot) = case stx of+            Nothing -> (Nothing, op)+            Just (d, zp) -> (Just d, zp)+        cont = do+            guard $ significant np pivot+            return $ do+                let d' = dir pivot np+                when (isNothing stx || od /= d') $ hook d'+                io $ writeIORef st (Just (d', np))+    fromMaybe (return ()) cont+    where+    significant a b = delta a b >= 10++-- | @'mouseGestureH' moveHook endHook@ is a mouse button+-- event handler. It collects mouse movements, calling @moveHook@ for each+-- update; when the button is released, it calls @endHook@.+mouseGestureH :: (Direction -> X ()) -> X () -> X ()+mouseGestureH moveHook endHook = do+    dpy <- asks display+    root <- asks theRoot+    (pos, acc) <- io $ do+        (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root+        r <- newIORef Nothing+        return ((fromIntegral ix, fromIntegral iy), r)+    mouseDrag (gauge moveHook pos acc) endHook++-- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to+-- look up the mouse gesture, then executes the corresponding action (if any).+mouseGesture :: Map [Direction] (Window -> X ()) -> Window -> X ()+mouseGesture tbl win = do+    (mov, end) <- mkCollect+    mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->+        case M.lookup gest tbl of+            Nothing -> return ()+            Just f -> f win++-- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two+-- callback functions for passing to 'mouseGestureH'. The move hook will+-- collect mouse movements (and return the current gesture as a list); the end+-- hook will return a list of the completed gesture, which you can access with+-- 'Control.Monad.>>='.+mkCollect :: (MonadIO m, MonadIO m') => m (Direction -> m' [Direction], m' [Direction])+mkCollect = liftIO $ do+    acc <- newIORef []+    let+        mov d = liftIO $ do+            ds <- readIORef acc+            let ds' = d : ds+            writeIORef acc ds'+            return $ reverse ds'+        end = liftIO $ do+            ds <- readIORef acc+            writeIORef acc []+            return $ reverse ds+    return (mov, end)
+ XMonad/Actions/MouseResize.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.MouseResize+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier to resize windows with the mouse by grabbing the+-- window's lower right corner.+--+-- This module must be used together with "XMonad.Layout.WindowArranger".+-----------------------------------------------------------------------------++module XMonad.Actions.MouseResize+    ( -- * Usage:+      -- $usage+      mouseResize+    , MouseResize (..)+    ) where++import Control.Monad+import Data.Maybe++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.LayoutModifier++import XMonad.Layout.WindowArranger+import XMonad.Util.XUtils++-- $usage+-- Usually this module is used to create layouts, but you can also use+-- it to resize windows in any layout, together with the+-- "XMonad.Layout.WindowArranger". For usage example see+-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".+--+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.MouseResize+-- > import XMonad.Layout.WindowArranger+--+-- Then edit your @layoutHook@ by modifying a given layout:+--+-- > myLayouts = mouseResize $ windowArrange $ layoutHook defaultConfig+--+-- and then:+--+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++mouseResize :: l a -> ModifiedLayout MouseResize l a+mouseResize = ModifiedLayout (MR [])++data MouseResize a = MR [((a,Rectangle),Maybe a)]+instance Show (MouseResize a) where show        _ = ""+instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]++instance LayoutModifier MouseResize Window where+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)+    redoLayout (MR st) _ (Just s) wrs+        | [] <- st  = initState    >>= \nst -> return (wrs, Just $ MR nst)+        | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)+        where+          wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs+          initState    = mapM createInputWindow wrs'+          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'++          inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10++          wrs_to_state rs ((w,r):xs)+              | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs+              | otherwise         = ((w,r),Nothing) : wrs_to_state (r:   rs) xs+              where ir = inputRectangle r+          wrs_to_state _ [] = []++    handleMess (MR s) m+        | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ MR [])+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR [])+        where releaseResources = mapM_ (deleteInputWin . snd) s+    handleMess _ _ = return Nothing++handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()+handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }+    | et == buttonPress+    , Just (w,Rectangle wx wy _ _) <- getWin ew st = do+                                        focus w+                                        mouseDrag (\x y -> do+                                                     let rect = Rectangle wx wy+                                                                (max 1 . fi $ x - wx)+                                                                (max 1 . fi $ y - wy)+                                                     sendMessage (SetGeometry rect)) (return ())++      where+        getWin w (((win,r),tw):xs)+            | Just w' <- tw+            , w == w'   = Just (win,r)+            | otherwise = getWin w xs+        getWin _ []     = Nothing+handleResize _ _ = return ()++createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)+createInputWindow ((w,r),mr) = do+  case mr of+    Just tr  -> withDisplay $ \d -> do+                  tw <- mkInputWindow d tr+                  io $ selectInput d tw (exposureMask .|. buttonPressMask)+                  showWindow tw+                  return ((w,r), Just tw)+    Nothing ->    return ((w,r), Nothing)++deleteInputWin :: Maybe Window -> X ()+deleteInputWin = maybe (return ()) deleteWindow++mkInputWindow :: Display -> Rectangle -> X Window+mkInputWindow d (Rectangle x y w h) = do+  rw <- asks theRoot+  let screen   = defaultScreenOfDisplay d+      visual   = defaultVisualOfScreen screen+      attrmask = cWOverrideRedirect+  io $ allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes True+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
+ XMonad/Actions/NoBorders.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.NoBorders+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Lukas Mai <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module provides helper functions for dealing with window borders.+--+-----------------------------------------------------------------------------++module XMonad.Actions.NoBorders (+    toggleBorder+) where++import XMonad++-- | Toggle the border of the currently focused window. To use it, add a+-- keybinding like so:+--+-- > , ((modMask x,  xK_g ),   withFocused toggleBorder)+--+toggleBorder :: Window -> X ()+toggleBorder w = do+    bw <- asks (borderWidth . config)+    withDisplay $ \d -> io $ do+        cw <- wa_border_width `fmap` getWindowAttributes d w+        if cw == 0+            then setWindowBorderWidth d w bw+            else setWindowBorderWidth d w 0
+ XMonad/Actions/PerWorkspaceKeys.hs view
@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.PerWorkspaceKeys+-- Copyright   :  (c) Roman Cheplyaka, 2008+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Define key-bindings on per-workspace basis.+--+-----------------------------------------------------------------------------++module XMonad.Actions.PerWorkspaceKeys (+                                 -- * Usage+                                 -- $usage+                                 chooseAction,+                                 bindOn+                                ) where++import XMonad+import XMonad.StackSet as S+import Data.List (find)++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >  import XMonad.Actions.PerWorkspaceKeys+--+-- >   ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")])+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Uses supplied function to decide which action to run depending on current workspace name.+chooseAction :: (String->X()) -> X()+chooseAction f = withWindowSet (f . S.currentTag)++-- | If current workspace is listed, run appropriate action (only the first match counts!)+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.+bindOn :: [(String, X())] -> X()+bindOn bindings = chooseAction chooser where+    chooser ws = case find ((ws==).fst) bindings of+        Just (_, action) -> action+        Nothing -> case find ((""==).fst) bindings of+            Just (_, action) -> action+            Nothing -> return ()+
+ XMonad/Actions/PhysicalScreens.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.PhysicalScreens+-- Copyright    : (c) Nelson Elhage <nelhage@mit.edu>+-- License      : BSD+--+-- Maintainer   : Nelson Elhage <nelhage@mit.edu>+-- Stability    : unstable+-- Portability  : unportable+--+-- Manipulate screens ordered by physical location instead of ID+-----------------------------------------------------------------------------++module XMonad.Actions.PhysicalScreens (+                                        -- * Usage+                                        -- $usage+                                        PhysicalScreen(..)+                                      , getScreen+                                      , viewScreen+                                      , sendToScreen+                                      ) where++import XMonad+import qualified XMonad.StackSet as W++import qualified Graphics.X11.Xlib as X+import Graphics.X11.Xinerama++import Data.List (sortBy)+import Data.Function (on)++{- $usage++This module allows you name Xinerama screens from XMonad using their+physical location reletive to each other (as reported by Xinerama),+rather than their @ScreenID@ s, which are arbitrarily determined by+your X server and graphics hardware.++Screens are ordered by the upper-left-most corner, from top-to-bottom+and then left-to-right.++Example usage in your @~\/.xmonad\/xmonad.hs@ file:++> import XMonad.Actions.PhysicalSCreens++> --+> -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3+> -- mod-shift-{w,e,r}, Move client to screen 1, 2, or 3+> --+> [((modMask .|. mask, key), f sc)+>     | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]+>     , (f, mask) <- [(viewScreen, 0), (sendToScreen, shiftMask)]]++For detailed instructions on editing your key bindings, see+"XMonad.Doc.Extending#Editing_key_bindings".+ -}++-- | The type of the index of a screen by location+newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)++-- | Translate a physical screen index to a "ScreenId"+getScreen :: PhysicalScreen -> X (Maybe ScreenId)+getScreen (P i) = withDisplay $ \dpy -> do+                    screens <- io $ getScreenInfo dpy+                    if i >= length screens+                     then return Nothing+                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]+                          in return $ Just $ snd $ ss !! i++-- | Switch to a given physical screen+viewScreen :: PhysicalScreen -> X ()+viewScreen p = do i <- getScreen p+                  whenJust i $ \s -> do+                  w <- screenWorkspace s+                  whenJust w $ windows . W.view++-- | Send the active window to a given physical screen+sendToScreen :: PhysicalScreen -> X ()+sendToScreen p = do i <- getScreen p+                    whenJust i $ \s -> do+                      w <- screenWorkspace s+                      whenJust w $ windows . W.shift++-- | Compare two screens by their top-left corners, ordering+-- | top-to-bottom and then left-to-right.+cmpScreen :: Rectangle -> Rectangle -> Ordering+cmpScreen  (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+ XMonad/Actions/Plane.hs view
@@ -0,0 +1,229 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Plane+-- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,+--                    Leonardo Serra <leoserra@minaslivre.org>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Marco Túlio Gontijo e Silva <marcot@riseup.net>+-- Stability   :  unstable+-- Portability :  unportable+--+-- This module has functions to navigate through workspaces in a bidimensional+-- manner.  It allows the organization of workspaces in lines, and provides+-- functions to move and shift windows in all four directions (left, up, right+-- and down) possible in a surface.+--+-- This functionality was inspired by GNOME (finite) and KDE (infinite)+-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for+-- the idea of applying this approach to XMonad.+-----------------------------------------------------------------------------++module XMonad.Actions.Plane+    (+    -- * Usage+    -- $usage++    -- * Data types+    Direction (..)+    , Limits (..)+    , Lines (..)++    -- * Key bindings+    , planeKeys++    -- * Navigating through workspaces+    , planeShift+    , planeMove+    )+    where++import Control.Monad+import Data.List+import Data.Map hiding (split)+import Data.Maybe++import XMonad+import XMonad.StackSet hiding (workspaces)+import XMonad.Util.Run++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Actions.Plane+-- >+-- > main = xmonad defaultConfig {keys = myKeys}+-- >+-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf+-- >+-- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Direction to go in the plane.+data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Enum++-- | Defines the behaviour when you're trying to move out of the limits.+data Limits+    = Finite   -- ^ Ignore the function call, and keep in the same workspace.+    | Circular -- ^ Get on the other side, like in the Snake game.+    | Linear   -- ^ The plan comes as a row, so it goes to the next or prev if+               -- the workspaces were numbered.+    deriving Eq++-- | The number of lines in which the workspaces will be arranged.  It's+-- possible to use a number of lines that is not a divisor of the number of+-- workspaces, but the results are better when using a divisor.  If it's not a+-- divisor, the last line will have the remaining workspaces.+data Lines+    = GConf     -- ^ Use @gconftool-2@ to find out the number of lines.+    | Lines Int -- ^ Specify the number of lines explicity.++-- | This is the way most people would like to use this module.  It ataches the+-- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and+-- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'.+-- It also associates these bindings with 'shiftMask' to 'planeShift'.+planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ())+planeKeys modm ln limits =+  fromList $+  [ ((keyMask, keySym), function ln limits direction)+  | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft+  , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)]+  ]++-- | Shift a window to the next workspace in 'Direction'.  Note that this will+-- also move to the next workspace.  It's a good idea to use the same 'Lines'+-- and 'Limits' for all the bindings.+planeShift :: Lines -> Limits -> Direction -> X ()+planeShift = plane shift'++shift' ::+    (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd+shift' area = greedyView area . shift area++-- | Move to the next workspace in 'Direction'.+planeMove :: Lines -> Limits -> Direction -> X ()+planeMove = plane greedyView++plane ::+    (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->+    X ()+plane function numberLines_ limits direction = do+    state <- get+    xconf <- ask++    numberLines <-+        liftIO $+        case numberLines_ of+            Lines numberLines__ ->+                return numberLines__+            GConf               ->+                do+                    numberLines__ <-+                        runProcessWithInput gconftool parameters ""+                    case reads numberLines__ of+                        [(numberRead, _)] -> return numberRead+                        _                 ->+                            do+                                trace $+                                    "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool +++                                    unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1."+                                return 1++    let+        notBorder :: Bool+        notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction++        circular_ :: Int+        circular_ = circular currentWS++        circular :: Int -> Int+        circular =+            [ onLine   pred+            , onColumn pred+            , onLine   succ+            , onColumn succ+            ]+            !! fromEnum direction++        linear :: Int -> Int+        linear =+            [ onLine   pred . onColumn pred+            , onColumn pred . onLine pred+            , onLine   succ . onColumn succ+            , onColumn succ . onLine succ+            ]+            !! fromEnum direction++        onLine :: (Int -> Int) -> Int -> Int+        onLine f currentWS_+            | line < areasLine = mod_ columns+            | otherwise        = mod_ areasColumn+            where+                line, column :: Int+                (line, column) = split currentWS_++                mod_ :: Int -> Int+                mod_ columns_ = compose line $ mod (f column) columns_++        onColumn :: (Int -> Int) -> Int -> Int+        onColumn f currentWS_+            | column < areasColumn || areasColumn == 0  = mod_ numberLines+            | otherwise                                 = mod_ $ pred numberLines+            where+                line, column :: Int+                (line, column) = split currentWS_++                mod_ :: Int -> Int+                mod_ lines_ = compose (mod (f line) lines_) column++        compose :: Int -> Int -> Int+        compose line column = line * columns + column++        split :: Int -> (Int, Int)+        split currentWS_ =+            (operation div, operation mod)+            where+                operation :: (Int -> Int -> Int) -> Int+                operation f = f currentWS_ columns++        areasLine :: Int+        areasLine = div areas columns++        areasColumn :: Int+        areasColumn = mod areas columns++        columns :: Int+        columns =+            if mod areas numberLines == 0 then preColumns else preColumns + 1++        currentWS :: Int+        currentWS = fromJust mCurrentWS++        preColumns :: Int+        preColumns = div areas numberLines++        mCurrentWS :: Maybe Int+        mCurrentWS = elemIndex (currentTag $ windowset state) areaNames++        areas :: Int+        areas = length areaNames++        run :: (Int -> Int) -> X ()+        run f = windows $ function $ areaNames !! f currentWS++        areaNames :: [String]+        areaNames = workspaces $ config xconf++    when (isJust mCurrentWS) $+        case limits of+        Finite   -> when notBorder $ run circular+        Circular -> run circular+        Linear -> if notBorder then run circular else run linear++gconftool :: String+gconftool = "gconftool-2"++parameters :: [String]+parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]
+ XMonad/Actions/Promote.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.Promote+-- Copyright   :  (c) Miikka Koskinen 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  xmonad@s001.ethrael.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Alternate promote function for xmonad.+--+-- Moves the focused window to the master pane. All other windows+-- retain their order. If focus is in the master, swap it with the+-- next window in the stack. Focus stays in the master.+--+-----------------------------------------------------------------------------++module XMonad.Actions.Promote (+                                 -- * Usage+                                 -- $usage+                                 promote+                                ) where++import XMonad+import XMonad.StackSet++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.Promote+--+-- then add a keybinding or substitute 'promote' in place of swapMaster:+--+-- >   , ((modMask x,               xK_Return), promote)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Move the focused window to the master pane. All other windows+--   retain their order. If focus is in the master, swap it with the+--   next windo in the stack. Focus stays in the master.+promote :: X ()+promote = windows $ modify' $+          \c -> case c of+                Stack _ [] []     -> c+                Stack t [] (x:rs) -> Stack x [] (t:rs)+                Stack t ls rs     -> Stack t [] (reverse ls ++ rs)
+ XMonad/Actions/RotSlaves.hs 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/Search.hs view
@@ -0,0 +1,373 @@+{- | Module      :  XMonad.Actions.Search+   Copyright   :  (C) 2007 Gwern Branwen+   License     :  None; public domain++   Maintainer  :  <gwern0@gmail.com>+   Stability   :  unstable+   Portability :  unportable; depends on XSelection, XPrompt++   A module for easily running Internet searches on web sites through xmonad.+   Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.++   Additional sites welcomed. -}+module XMonad.Actions.Search (   -- * Usage+                                 -- $usage+                                 search,+                                 SearchEngine(..),+                                 searchEngine,+                                 searchEngineF,+                                 promptSearch,+                                 promptSearchBrowser,+                                 selectSearch,+                                 selectSearchBrowser,+                                 hasPrefix,+                                 escape,+                                 use,+                                 intelligent,+                                 (!>),+                                 prefixAware,+                                 namedEngine,++                                 amazon,+                                 codesearch,+                                 deb,+                                 debbts,+                                 debpts,+                                 dictionary,+                                 google,+                                 hackage,+                                 hoogle,+                                 images,+                                 imdb,+                                 isohunt,+                                 maps,+                                 mathworld,+                                 scholar,+                                 thesaurus,+                                 wayback,+                                 wikipedia,+                                 youtube,+                                 multi+                                  -- * Use case: searching with a submap+                                  -- $tip+                          ) where++import Data.Char (chr, ord, isAlpha, isMark, isDigit)+import Numeric (showIntAtBase)+import XMonad (X(), MonadIO, liftIO)+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletion)+import XMonad.Prompt.Shell (getBrowser)+import XMonad.Util.Run (safeSpawn)+import XMonad.Util.XSelection (getSelection)++{- $usage++   This module is intended to allow easy access to databases on the+   Internet through xmonad's interface. The idea is that one wants to+   run a search but the query string and the browser to use must come+   from somewhere. There are two places the query string can come from+   - the user can type it into a prompt which pops up, or the query+   could be available already in the X Windows copy\/paste buffer+   (perhaps you just highlighted the string of interest).++   Thus, there are two main functions: 'promptSearch', and+   'selectSearch' (implemented using the more primitive 'search'). To+   each of these is passed an engine function; this is a function that+   knows how to search a particular site.++   For example, the 'google' function knows how to search Google, and+   so on. You pass 'promptSearch' and 'selectSearch' the engine you+   want, the browser you want, and anything special they might need;+   this whole line is then bound to a key of you choosing in your+   xmonad.hs. For specific examples, see each function.  This module+   is easily extended to new sites by using 'searchEngine'.++   The currently available search engines are:++* 'amazon' -- Amazon keyword search.++* 'codesearch' -- Google Labs Code Search search.++* 'deb'    -- Debian package search.++* 'debbts' -- Debian Bug Tracking System.++* 'debpts'  -- Debian Package Tracking System.++* 'dictionary' -- dictionary.reference.com search.++* 'google' -- basic Google search.++* 'hackage' -- Hackage, the Haskell package database.++* 'hoogle' -- Hoogle, the Haskell libraries API search engine.++* 'images' -- Google images.++* 'imdb'   -- the Internet Movie Database.++* 'isohunt' -- isoHunt search.++* 'maps'   -- Google maps.++* 'mathworld' -- Wolfram MathWorld search.++* 'scholar' -- Google scholar academic search.++* 'thesaurus' -- thesaurus.reference.com search.++* 'wayback' -- the Wayback Machine.++* 'wikipedia' -- basic Wikipedia search.++* 'youtube' -- Youtube video search.++* 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.++Feel free to add more! -}++{- $tip++In combination with "XMonad.Actions.Submap" you can create a powerful+and easy way to search without adding a whole bunch of bindings.++First import the necessary modules:++> import qualified XMonad.Prompt         as P+> import qualified XMonad.Actions.Submap as SM+> import qualified XMonad.Actions.Search as S++Then add the following to your key bindings:++> ...+> -- Search commands+> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig)+> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)+>+> ...+>+> searchEngineMap method = M.fromList $+>       [ ((0, xK_g), method S.google)+>       , ((0, xK_h), method S.hoogle)+>       , ((0, xK_w), method S.wikipedia)+>       ]++Or in combination with XMonad.Util.EZConfig:++> ...+> ] -- end of regular keybindings+> -- Search commands+> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ]+> ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ]+>+> ...+>+> searchList :: [(String, S.SearchEngine)]+> searchList = [ ("g", S.google)+>              , ("h", S.hoohle)+>              , ("w", S.wikipedia)+>              ]++Make sure to set firefox to open new pages in a new window instead of+in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages+should be opened in...@++Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then+opens a new firefox window that performs the search on Google, Hoogle+or Wikipedia respectively.++If you select something in whatever application and hit /mod-shift-s/ ++/g/\//h/\//w/ it will search the selected string with the specified+engine.++Happy searching! -}++-- | A customized prompt indicating we are searching, and the name of the site.+data Search = Search Name+instance XPrompt Search where+    showXPrompt (Search name)= "Search [" ++ name ++ "]: "++-- | Escape the search string so search engines understand it.+-- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'+-- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.+escape :: String -> String+escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)+         where -- Copied from Network.URI.+           escapeURIString ::+               (Char -> Bool)      -- a predicate which returns 'False' if should escape+               -> String           -- the string to process+               -> String           -- the resulting URI string+           escapeURIString = concatMap . escapeURIChar+           escapeURIChar :: (Char->Bool) -> Char -> String+           escapeURIChar p c+               | p c       = [c]+               | otherwise = '%' : myShowHex (ord c) ""+               where+                 myShowHex :: Int -> ShowS+                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of+                                    []  -> "00"+                                    [ch] -> ['0',ch]+                                    cs  -> cs+                 toChrHex d+                   | d < 10    = chr (ord '0' + fromIntegral d)+                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))++type Browser      = FilePath+type Query        = String+type Site         = String -> String+type Name         = String+data SearchEngine = SearchEngine Name Site++-- | Given an already defined search engine, extracts its transformation+--   function, making it easy to create compound search engines.+--   For an instance you can use @use google@ to get a function which+--   makes the same transformation as the google search engine would.+use :: SearchEngine -> Site+use (SearchEngine _ engine) = engine++-- | Given a browser, a search engine's transformation function, and a search term, perform the+--   requested search in the browser.+search :: Browser -> Site -> Query -> X ()+search browser site query = safeSpawn browser $ site query++{- | Given a base URL, create the 'SearchEngine' that escapes the query and+   appends it to the base. You can easily define a new engine locally using+   exported functions without needing to modify "XMonad.Actions.Search":++> myNewEngine = searchEngine "site" "http://site.com/search="++   The important thing is that the site has a interface which accepts the escaped query+   string as part of the URL. Alas, the exact URL to feed searchEngine varies+   from site to site, often considerably, so there\'s no general way to cover this.++   Generally, examining the resultant URL of a search will allow you to reverse-engineer+   it if you can't find the necessary URL already described in other projects such as Surfraw. -}+searchEngine :: Name -> String -> SearchEngine+searchEngine name site = searchEngineF name (\s -> site ++ (escape s))++{- | If your search engine is more complex than this (you may want to identify+   the kind of input and make the search URL dependent on the input or put the query+   inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.++> searchFunc :: String -> String+> searchFunc s | s `hasPrefix` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)+>              | s `hasPrefix` "http://" = s+>              | otherwise               = (use google) s+> myNewEngine = searchEngineF "mymulti" searchFunc++   @searchFunc@ here searches for a word in wikipedia if it has a prefix+   of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address+   directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.+   You can use other engines inside of your own through the 'use' function as shown above to make+   complex searches.++   The user input will be automatically escaped in search engines created with 'searchEngine',+   'searchEngineF', however, completely depends on the transformation function passed to it. -}+searchEngineF :: Name -> Site -> SearchEngine+searchEngineF = SearchEngine+++-- The engines.+amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images,+  imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia,+  youtube :: SearchEngine+amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="+codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="+deb        = searchEngine "deb"        "http://packages.debian.org/"+debbts     = searchEngine "debbts"     "http://bugs.debian.org/"+debpts     = searchEngine "debpts"     "http://packages.qa.debian.org/"+dictionary = searchEngine "dict"       "http://dictionary.reference.com/browse/"+google     = searchEngine "google"     "http://www.google.com/search?num=100&q="+hackage    = searchEngine "hackage"    "http://hackage.haskell.org/cgi-bin/hackage-scripts/package/"+hoogle     = searchEngine "hoogle"     "http://www.haskell.org/hoogle/?q="+images     = searchEngine "images"     "http://images.google.fr/images?q="+imdb       = searchEngine "imdb"       "http://www.imdb.com/Find?select=all&for="+isohunt    = searchEngine "isohunt"    "http://isohunt.com/torrents/?ihq="+maps       = searchEngine "maps"       "http://maps.google.com/maps?q="+mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="+scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="+thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="+wikipedia  = searchEngine "wiki"       "https://secure.wikimedia.org/wikipedia/en/wiki/Special:Search?go=Go&search="+youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="+{- This doesn't seem to work, but nevertheless, it seems to be the official+   method at <http://web.archive.org/collections/web/advanced.html> to get the+   latest backup. -}+wayback   = searchEngine "wayback" "http://web.archive.org/"++multi :: SearchEngine+multi = namedEngine "multi" $ foldr1 (!>) [amazon, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, maps, mathworld, scholar, thesaurus, wayback, wikipedia, (prefixAware google)]++{- | This function wraps up a search engine and creates a new one, which works+   like the argument, but goes directly to a URL if one is given rather than+   searching.++> myIntelligentGoogleEngine = intelligent google++   Now if you search for http:\/\/xmonad.org it will directly open in your browser-}+intelligent :: SearchEngine -> SearchEngine+intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))++{- | Checks if a string starts with a given prefix -}+hasPrefix :: String -> String -> Bool+hasPrefix _ [] = True+hasPrefix [] (_:_) = False+hasPrefix (t:ts) (p:ps) = if t == p then hasPrefix ts ps else False++removeColonPrefix :: String -> String+removeColonPrefix str = tail $ snd $ break (==':') str++{- | Connects a few search engines into one. If the search engines\' names are+   \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query+   is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases.++   Example:++> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google))++  Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia,+  \"mathworld:integral\" will search mathworld, and everything else will fall back to+  google. The use of intelligent will make sure that URLs are opened directly. -}+(!>) :: SearchEngine -> SearchEngine -> SearchEngine+(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `hasPrefix` (name1++":") then site1 (removeColonPrefix s) else site2 s)++{- | Makes a search engine prefix-aware. Especially useful together with '!>'.+   It will automatically remove the prefix from a query so that you don\'t end+	 up searching for google:xmonad if google is your fallback engine and you+	 explicitly add the prefix. -}+prefixAware :: SearchEngine -> SearchEngine+prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `hasPrefix` (name++":") then site $ removeColonPrefix s else site s)++{- | Changes search engine's name -}+namedEngine :: Name -> SearchEngine -> SearchEngine+namedEngine name (SearchEngine _ site) = searchEngineF name site++{- | Like 'search', but for use with the output from a Prompt; it grabs the+   Prompt's result, passes it to a given searchEngine and opens it in a given+   browser. -}+promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()+promptSearchBrowser config browser (SearchEngine name site) = mkXPrompt (Search name) config historyCompletion $ search browser site++{- | Like 'search', but in this case, the string is not specified but grabbed+ from the user's response to a prompt. Example:++> , ((modm, xK_g), promptSearch greenXPConfig google)++   This specializes "promptSearchBrowser" by supplying the browser argument as+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}+promptSearch :: XPConfig -> SearchEngine -> X ()+promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine++-- | Like 'search', but for use with the X selection; it grabs the selection,+--   passes it to a given searchEngine and opens it in a given browser.+selectSearchBrowser :: Browser -> SearchEngine -> X ()+selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection++{- | Like 'search', but for use with the X selection; it grabs the selection,+   passes it to a given searchEngine and opens it in the default browser . Example:++> , ((modm .|. shiftMask, xK_g), selectSearch google)++   This specializes "selectSearchBrowser" by supplying the browser argument as+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}+selectSearch :: SearchEngine -> X ()+selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine
+ 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,34 @@+-----------------------------------------------------------------------------+-- |+-- 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.  Note that the functionality of+-- this module has been folded into the more general+-- "XMonad.Actions.WithAll"; this module simply re-exports the+-- 'sinkAll' function for backwards compatibility.+-----------------------------------------------------------------------------++module XMonad.Actions.SinkAll (+    -- * Usage+    -- $usage++    sinkAll) where++import XMonad.Actions.WithAll (sinkAll)++-- $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".
+ XMonad/Actions/SpawnOn.hs view
@@ -0,0 +1,114 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.SpawnOn+-- Copyright    : (c) Spencer Janssen+-- License      : BSD+--+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>+-- Stability    : unstable+-- Portability  : unportable+--+-- Provides a way to spawn an application on a specific workspace by using+-- the _NET_WM_PID property that most windows set on creation. Hence this module+-- won't work on applications that don't set this property.+--+-----------------------------------------------------------------------------++module XMonad.Actions.SpawnOn (+    -- * Usage+    -- $usage+    Spawner,+    mkSpawner,+    manageSpawn,+    spawnHere,+    spawnOn,+    shellPromptHere,+    shellPromptOn+) where++import Data.List (isInfixOf)+import Data.IORef+import System.Posix.Types (ProcessID)++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Hooks.ManageHelpers+import XMonad.Prompt+import XMonad.Prompt.Shell++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad.Actions.SpawnOn+--+-- >    main = do+-- >      sp <- mkSpawner+-- >      xmonad defaultConfig {+-- >         ...+-- >         manageHook = manageSpawn sp <+> manageHook defaultConfig+-- >         ...+-- >      }+--+-- To ensure that application appears on a workspace it was launched at, add keybindings like:+--+-- >  , ((mod1Mask,xK_o), spawnHere sp "urxvt")+-- >  , ((mod1Mask,xK_s), shellPromptHere sp defaultXPConfig)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++newtype Spawner = Spawner {pidsRef :: IORef [(ProcessID, WorkspaceId)]}++maxPids :: Int+maxPids = 5++-- | Create 'Spawner' which then has to be passed to other functions.+mkSpawner :: (Functor m, MonadIO m) => m Spawner+mkSpawner = io . fmap Spawner $ newIORef []++-- | Provides a manage hook to react on process spawned with+-- 'spawnOn', 'spawnHere' etc.+manageSpawn :: Spawner -> ManageHook+manageSpawn sp = do+    pids <- io . readIORef $ pidsRef sp+    mp <- pid+    case flip lookup pids =<< mp of+        Nothing -> doF id+        Just w  -> do+            whenJust mp $ \p ->+                io . modifyIORef (pidsRef sp) $ filter ((/= p) . fst)+            doShift w++mkPrompt :: (String -> X ()) -> XPConfig -> X ()+mkPrompt cb c = do+    cmds <- io $ getCommands+    mkXPrompt Shell c (getShellCompl cmds) cb++-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches+-- application on current workspace.+shellPromptHere :: Spawner -> XPConfig -> X ()+shellPromptHere sp = mkPrompt (spawnHere sp)++-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches+-- application on given workspace.+shellPromptOn :: Spawner -> WorkspaceId -> XPConfig -> X ()+shellPromptOn sp ws = mkPrompt (spawnOn sp ws)++-- | Replacement for 'spawn' which launches+-- application on current workspace.+spawnHere :: Spawner -> String -> X ()+spawnHere sp cmd = withWindowSet $ \ws -> spawnOn sp (W.currentTag ws) cmd++-- | Replacement for 'spawn' which launches+-- application on given workspace.+spawnOn :: Spawner -> WorkspaceId -> String -> X ()+spawnOn sp ws cmd = do+    p <- spawnPID $ mangle cmd+    io $ modifyIORef (pidsRef sp) (take maxPids . ((p, ws) :))+ where+    -- TODO this is silly, search for a better solution+    mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs+              | otherwise = "exec " ++ xs+    metaChars = "&|;"+
+ XMonad/Actions/Submap.hs view
@@ -0,0 +1,81 @@+-----------------------------------------------------------------------------+-- |+-- 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,+                             submapDefault+                            ) 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 = submapDefault (return ()) keys++-- | Like 'submap', but executes a default action if the key did not match.+submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()+submapDefault def 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)++    m' <- cleanMask m+    maybe def id (M.lookup (m', s) keys)++    io $ ungrabKeyboard d currentTime
+ XMonad/Actions/SwapWorkspaces.hs view
@@ -0,0 +1,64 @@+-----------------------------------------------------------------------------+-- |+-- 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,+                                     swapTo,+                                     swapWorkspaces,+                                     WSDirection(..)+                                    ) where++import XMonad (windows, X())+import XMonad.StackSet+import XMonad.Actions.CycleWS+import XMonad.Util.WorkspaceCompare+++-- $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 (currentTag s) s++-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.+-- This is an @X ()@ so can be hooked up to your keybindings directly.+swapTo :: WSDirection -> X ()+swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent++-- | 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,194 @@+-----------------------------------------------------------------------------+-- |+-- 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 = currentTag 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) . index >>= 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 (currentTag 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
+ XMonad/Actions/TopicSpace.hs view
@@ -0,0 +1,335 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.TopicSpace+-- Copyright   :  (c) Nicolas Pouillard+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Nicolas Pouillard <nicolas.pouillard@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Turns your workspaces into a more topic oriented system.+--+-- This module allows to organize your workspaces on a precise topic basis.  So+-- instead of having a workspace called `work' you can setup one workspace per+-- task.  Here we call these workspaces, topics. The great thing with+-- topics is that one can attach a directory that makes sense to each+-- particular topic.  One can also attach an action which will be triggered+-- when switching to a topic that does not have any windows in it.  So you can+-- attach your mail client to the mail topic, some terminals in the right+-- directory to the xmonad topic... This package also provides a nice way to+-- display your topics in an historical way using a custom `pprWindowSet'+-- function. You can also easily switch to recents topics using this history+-- of last focused topics.+--+-- Here is an example of configuration using TopicSpace:+--+-- @+-- -- The list of all topics/workspaces of your xmonad configuration.+-- -- The order is important, new topics must be inserted+-- -- at the end of the list if you want hot-restarting+-- -- to work.+-- myTopics :: [Topic]+-- myTopics =+--   [ \"dashboard\" -- the first one+--   , \"admin\", \"build\", \"cleaning\", \"conf\", \"darcs\", \"haskell\", \"irc\"+--   , \"mail\", \"movie\", \"music\", \"talk\", \"text\", \"tools\", \"web\", \"xmonad\"+--   , \"yi\", \"documents\", \"twitter\", \"pdf\"+--   ]+-- @+--+-- @+--  myTopicConfig :: TopicConfig+--  myTopicConfig = TopicConfig+--    { topicDirs = M.fromList $+--        [ (\"conf\", \"w\/conf\")+--        , (\"dashboard\", \"Desktop\")+--        , (\"yi\", \"w\/dev-haskell\/yi\")+--        , (\"darcs\", \"w\/dev-haskell\/darcs\")+--        , (\"haskell\", \"w\/dev-haskell\")+--        , (\"xmonad\", \"w\/dev-haskell\/xmonad\")+--        , (\"tools\", \"w\/tools\")+--        , (\"movie\", \"Movies\")+--        , (\"talk\", \"w\/talks\")+--        , (\"music\", \"Music\")+--        , (\"documents\", \"w\/documents\")+--        , (\"pdf\", \"w\/documents\")+--        ]+--    , defaultTopicAction = const $ spawnShell >*> 3+--    , defaultTopic = \"dashboard\"+--    , maxTopicHistory = 10+--    , topicActions = M.fromList $+--        [ (\"conf\",       spawnShell >> spawnShellIn \"wd\/ertai\/private\")+--        , (\"darcs\",      spawnShell >*> 3)+--        , (\"yi\",         spawnShell >*> 3)+--        , (\"haskell\",    spawnShell >*> 2 >>+--                         spawnShellIn \"wd\/dev-haskell\/ghc\")+--        , (\"xmonad\",     spawnShellIn \"wd\/x11-wm\/xmonad\" >>+--                         spawnShellIn \"wd\/x11-wm\/xmonad\/contrib\" >>+--                         spawnShellIn \"wd\/x11-wm\/xmonad\/utils\" >>+--                         spawnShellIn \".xmonad\" >>+--                         spawnShellIn \".xmonad\")+--        , (\"mail\",       mailAction)+--        , (\"irc\",        ssh somewhere)+--        , (\"admin\",      ssh somewhere >>+--                         ssh nowhere)+--        , (\"dashboard\",  spawnShell)+--        , (\"twitter\",    spawnShell)+--        , (\"web\",        spawn browserCmd)+--        , (\"movie\",      spawnShell)+--        , (\"documents\",  spawnShell >*> 2 >>+--                         spawnShellIn \"Documents\" >*> 2)+--        , (\"pdf\",        spawn pdfViewerCmd)+--        ]+--    }+-- @+--+-- @+--  -- extend your keybindings+--  myKeys =+--    [ ((modMask              , xK_n     ), spawnShell) -- %! Launch terminal+--    , ((modMask              , xK_a     ), currentTopicAction myTopicConfig)+--    , ((modMask              , xK_g     ), promptedGoto)+--    , ((modMask .|. shiftMask, xK_g     ), promptedShift)+--    ...+--    ]+--    +++--    [ ((modMask, k), switchNthLastFocused defaultTopic i)+--    | (i, k) <- zip [1..] workspaceKeys]+-- @+--+-- @+--  spawnShell :: X ()+--  spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn+-- @+--+-- @+--  spawnShellIn :: Dir -> X ()+--  spawnShellIn dir = spawn $ \"urxvt '(cd ''\" ++ dir ++ \"'' && \" ++ myShell ++ \" )'\"+-- @+--+-- @+--  goto :: Topic -> X ()+--  goto = switchTopic myTopicConfig+-- @+--+-- @+--  promptedGoto :: X ()+--  promptedGoto = workspacePrompt myXPConfig goto+-- @+--+-- @+--  promptedShift :: X ()+--  promptedShift = workspacePrompt myXPConfig $ windows . W.shift+-- @+--+-- @+--  myConfig = do+--      checkTopicConfig myTopics myTopicConfig+--      myLogHook <- makeMyLogHook+--      return $ defaultConfig+--           { borderWidth = 1 -- Width of the window border in pixels.+--           , workspaces = myTopics+--           , layoutHook = myModifiers myLayouts+--           , manageHook = myManageHook+--           , logHook = myLogHook+--           , handleEventHook = myHandleEventHook+--           , terminal = myTerminal -- The preferred terminal program.+--           , normalBorderColor = \"#3f3c6d\"+--           , focusedBorderColor = \"#4f66ff\"+--           , XMonad.modMask = mod1Mask+--           , keys = myKeys+--           , mouseBindings = myMouseBindings+--           }+-- @+--+-- @+--  main :: IO ()+--  main = xmonad =<< myConfig+-- @+module XMonad.Actions.TopicSpace+  ( Topic+  , Dir+  , TopicConfig(..)+  , getLastFocusedTopics+  , setLastFocusedTopic+  , pprWindowSet+  , topicActionWithPrompt+  , topicAction+  , currentTopicAction+  , switchTopic+  , switchNthLastFocused+  , currentTopicDir+  , checkTopicConfig+  , (>*>)+  )+where++import XMonad++import Data.List+import Data.Maybe (fromMaybe, isNothing)+import Data.Ord+import qualified Data.Map as M+import Graphics.X11.Xlib+import Control.Monad ((=<<),liftM2,when,unless,replicateM_)+import System.IO+import Foreign.C.String (castCCharToChar,castCharToCChar)++import XMonad.Operations+import Control.Applicative ((<$>))+import qualified XMonad.StackSet as W++import XMonad.Prompt+import XMonad.Prompt.Workspace++import XMonad.Hooks.UrgencyHook+import XMonad.Hooks.DynamicLog (PP(..))+import qualified XMonad.Hooks.DynamicLog as DL++import XMonad.Util.Run (spawnPipe)++-- | An alias for @flip replicateM_@+(>*>) :: Monad m => m a -> Int -> m ()+(>*>) = flip replicateM_+infix >*>++-- | 'Topic' is just an alias for 'WorkspaceId'+type Topic = WorkspaceId++-- | 'Dir' is just an alias for 'FilePath' but should points to a directory.+type Dir = FilePath++-- | Here is the topic space configuration area.+data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir+                                 -- ^ This mapping associate a directory to each topic.+                               , topicActions       :: M.Map Topic (X ())+                                 -- ^ This mapping associate an action to trigger when+                                 -- switching to a given topic which workspace is empty.+                               , defaultTopicAction :: Topic -> X ()+                                 -- ^ This is the default topic action.+                               , defaultTopic       :: Topic+                                 -- ^ This is the default topic.+                               , maxTopicHistory    :: Int+                                 -- ^ This setups the maximum depth of topic history, usually+                                 -- 10 is a good default since we can bind all of them using+                                 -- numeric keypad.+                               }++-- | Returns the list of last focused workspaces the empty list otherwise.+-- This function rely on a reserved property namely _XMONAD_LAST_FOCUSED_WORKSPACES.+getLastFocusedTopics :: X [String]+getLastFocusedTopics = getStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"++-- | Given a 'TopicConfig', the last focused topic, and a predicate that will+-- select topics that one want to keep, this function will set the property+-- of last focused topics.+setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()+setLastFocusedTopic tg w predicate =+  getLastFocusedTopics >>=+    setStringListProp "_XMONAD_LAST_FOCUSED_WORKSPACES"+    . take (maxTopicHistory tg) . nub . (w:) . filter predicate++-- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration+-- and a pretty-printing record 'PP'. It will show the list of topics sorted historically+-- and highlighting topics with urgent windows.+pprWindowSet :: TopicConfig -> PP -> X String+pprWindowSet tg pp = do+    winset <- gets windowset+    urgents <- readUrgents+    let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset+        maxDepth = maxTopicHistory tg+    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)+                           (`notElem` empty_workspaces)+    lastWs <- getLastFocusedTopics+    let depth topic = elemIndex topic lastWs+        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic+        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }+        sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)+    return $ DL.pprWindowSet sortWindows urgents pp' winset++-- | Given a prompt configuration and a topic configuration, triggers the action associated with+-- the topic given in prompt.+topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()+topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))++-- | Given a configuration and a topic, triggers the action associated with the given topic.+topicAction :: TopicConfig -> Topic -> X ()+topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg++-- | Trigger the action associated with the current topic.+currentTopicAction :: TopicConfig -> X ()+currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current . windowset)++-- | Switch to the given topic.+switchTopic :: TopicConfig -> Topic -> X ()+switchTopic tg topic = do+  windows $ W.greedyView topic+  wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)+  when (null wins) $ topicAction tg topic++-- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.+switchNthLastFocused ::TopicConfig -> Int -> X ()+switchNthLastFocused tg depth = do+  lastWs <- getLastFocusedTopics+  switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth++-- | Returns the directory associated with current topic returns the empty string otherwise.+currentTopicDir :: TopicConfig -> X String+currentTopicDir tg = do+  topic <- gets (W.tag . W.workspace . W.current . windowset)+  return . fromMaybe "" . M.lookup topic $ topicDirs tg++-- | Check the given topic configuration for duplicates topics or undefined topics.+checkTopicConfig :: [Topic] -> TopicConfig -> IO ()+checkTopicConfig tags tg = do+    -- tags <- gets $ map W.tag . workspaces . windowset++    let+      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)+      dups       = tags \\ nub tags+      diffTopic  = seenTopics \\ sort tags+      check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst++    check diffTopic "Seen but missing topics/workspaces"+    check dups      "Duplicate topics/workspaces"++type StringProp = String++withStringProp :: StringProp -> (Display -> Window -> Atom -> X a) -> X a+withStringProp prop f =+  withDisplay $ \dpy -> do+    rootw <- asks theRoot+    a     <- io $ internAtom dpy prop False+    f dpy rootw a++-- | Get the name of a string property and returns it as a 'Maybe'.+getStringProp :: StringProp -> X (Maybe String)+getStringProp prop =+  withStringProp prop $ \dpy rootw a -> do+    p <- io $ getWindowProperty8 dpy a rootw+    return $ map castCCharToChar <$> p++-- | Set the value of a string property.+setStringProp :: StringProp -> String -> X ()+setStringProp prop string =+  withStringProp prop $ \dpy rootw a ->+    io $ changeProperty8 dpy rootw a a propModeReplace $ map castCharToCChar string++-- | Given a property name, returns its contents as a list. It uses the empty+-- list as default value.+getStringListProp :: StringProp -> X [String]+getStringListProp prop = return . maybe [] words =<< getStringProp prop++-- | Given a property name and a list, sets the value of this property with+-- the list given as argument.+setStringListProp :: StringProp -> [String] -> X ()+setStringListProp prop = setStringProp prop . unwords++-- | Display the given message using the @xmessage@ program.+xmessage :: String -> IO ()+xmessage s = do+  h <- spawnPipe "xmessage -file -"+  hPutStr h s+  hClose h+
+ XMonad/Actions/UpdateFocus.hs view
@@ -0,0 +1,61 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonadContrib.UpdateFocus+-- Copyright   :  (c) Daniel Schoepe+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Daniel Schoepe <asgaroth_@gmx.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Updates the focus on mouse move in unfocused windows.+--+-----------------------------------------------------------------------------++module XMonad.Actions.UpdateFocus (+    -- * Usage+    -- $usage+    focusOnMouseMove,+    adjustEventInput+) where++import XMonad+import qualified XMonad.StackSet as W+import Graphics.X11.Xlib.Extras+import Control.Monad (when)+import Data.Monoid++-- $usage+-- To make the focus update on mouse movement within an unfocused window, add the+-- following to your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.UpdateFocus+-- > xmonad $ defaultConfig {+-- >   ..+-- >   startupHook = adjustEventInput+-- >   handleEventHook = focusOnMouseMove+-- >   ..+-- > }+--+-- This module is probably only useful when focusFollowsMouse is set to True(default).++-- | Changes the focus if the mouse is moved within an unfocused window.+focusOnMouseMove :: Event -> X All+focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do+    -- check only every 15 px to avoid excessive calls to translateCoordinates+    when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do+      dpy <- asks display+      Just foc <- withWindowSet $ return . W.peek+      -- get the window under the pointer:+      (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)+      when (foc /= w) $ focus w+    return (All True)+focusOnMouseMove _ = return (All True)++-- | Adjusts the event mask to pick up pointer movements.+adjustEventInput :: X ()+adjustEventInput = withDisplay $ \dpy -> do+  rootw <- asks theRoot+  io $ selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask+                                .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask+                                .|. buttonPressMask .|. pointerMotionMask
+ XMonad/Actions/UpdatePointer.hs view
@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonadContrib.UpdatePointer+-- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Robert Marlow <robreim@bobturf.org>+-- Stability   :  stable+-- Portability :  portable+--+-- Causes the pointer to follow whichever window focus changes to. Compliments+-- the idea of switching focus as the mouse crosses window boundaries to+-- keep the mouse near the currently focused window+--+-----------------------------------------------------------------------------++module XMonad.Actions.UpdatePointer+    (+     -- * Usage+     -- $usage+     updatePointer+     , PointerPosition (..)+    )+    where++import XMonad+import Control.Monad+import XMonad.StackSet (member, peek, screenDetail, current)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Actions.UpdatePointer+--+-- Enable it by including it in your logHook definition. Eg:+--+-- > logHook = updatePointer Nearest+--+-- which will move the pointer to the nearest point of a newly focused window, or+--+-- > logHook = updatePointer (Relative 0.5 0.5)+--+-- which will move the pointer to the center of a newly focused window.+--+-- To use this with an existing logHook, use >> :+--+-- > logHook = dynamicLog+-- >           >> updatePointer (Relative 1 1)+--+-- which moves the pointer to the bottom-right corner of the focused window.++data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational+    deriving (Read,Show)++-- | Update the pointer's location to the currently focused+-- window or empty screen unless it's already there, or unless the user was changing+-- focus with the mouse+updatePointer :: PointerPosition -> X ()+updatePointer p = do+  ws <- gets windowset+  dpy <- asks display+  rect <- case peek ws of+        Nothing -> return $ (screenRect . screenDetail .current) ws+        Just w  -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)+  root <- asks theRoot+  mouseIsMoving <- asks mouseFocused+  (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root+  unless (pointWithin (fi rootx) (fi rooty) rect+          || mouseIsMoving+          || not (currentWindow `member` ws || currentWindow == none)) $+    case p of+    Nearest -> do+      let x = moveWithin (fi rootx) (rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))+          y = moveWithin (fi rooty) (rect_y rect) (fi (rect_y rect) + fi (rect_height rect))+      io $ warpPointer dpy none root 0 0 0 0 x y+    TowardsCentre xfrc yfrc -> do+      let cx = fi (rect_width rect) / 2 + fi (rect_x rect)+          cy = fi (rect_height rect) / 2 + fi (rect_y rect)+          x,y,cx,cy :: Rational+          x = moveWithin (fi rootx) (fi $ rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))+          y = moveWithin (fi rooty) (fi $ rect_y rect) (fi (rect_y rect) + fi (rect_height rect))+      io $ warpPointer dpy none root 0 0 0 0 (round $ x + xfrc*(cx-x)) (round $ y + yfrc*(cy-y))+    Relative h v ->+      io $ warpPointer dpy none root 0 0 0 0+           (rect_x rect + fraction h (rect_width rect))+           (rect_y rect + fraction v (rect_height rect))+        where fraction x y = floor (x * fromIntegral y)++windowAttributesToRectangle :: WindowAttributes -> Rectangle+windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))     (fi (wa_y wa))+                                           (fi (wa_width wa)) (fi (wa_height wa))+moveWithin :: Ord a => a -> a -> a -> a+moveWithin now lower upper =+    if now < lower+    then lower+    else if now > upper+         then upper+         else now++fi :: (Num b, Integral a) => a -> b+fi = fromIntegral
+ XMonad/Actions/Warp.hs view
@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- 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+                           banish,+                           banishScreen,+                           Corner(..),+                           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".+++data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight++{- | Move the mouse cursor to a corner of the focused window. Useful for+   uncluttering things.++   Internally, this uses numerical parameters. We parametrize on the 'Corner'+   type so the user need not see the violence inherent in+   the system.++   'warpToScreen' and 'warpToWindow' can be used in a variety of+   ways. Suppose you wanted to emulate Ratpoison's \'banish\' command,+   which moves the mouse pointer to a corner? warpToWindow can do that! -}+banish :: Corner -> X ()+banish direction = case direction of+                     LowerRight -> warpToWindow 1 1+                     LowerLeft  -> warpToWindow 0 1+                     UpperLeft  -> warpToWindow 0 0+                     UpperRight -> warpToWindow 1 0++{- | Same as 'banish' but moves the mouse to the corner of the+   currently focused screen -}+banishScreen :: Corner -> X ()+banishScreen direction = case direction of+                           LowerRight -> warpToCurrentScreen 1 1+                           LowerLeft  -> warpToCurrentScreen 0 1+                           UpperLeft  -> warpToCurrentScreen 0 0+                           UpperRight -> warpToCurrentScreen 1 0+    where+      warpToCurrentScreen h v =+          do ws <- gets windowset+             warpToScreen (W.screen $ current ws) h v+             windows (const ws)+++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,91 @@+-----------------------------------------------------------------------------+-- |+-- 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, gotoMenu', bringMenu, windowMap,+				    bringWindow+				   ) 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 (menuMap)+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 = actionMenu W.focusWindow++gotoMenu' :: String -> X ()+gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow++-- | Pops open a dmenu with window titles. Choose one, and it will be+--   dragged, kicking and screaming, into your current workspace.+bringMenu :: X ()+bringMenu = actionMenu bringWindow++-- | Brings the specified window into the current workspace.+bringWindow :: Window -> X.WindowSet -> X.WindowSet+bringWindow w ws = W.shiftWin (W.currentTag ws) w ws++-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action+--   if found.+actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()+actionMenu action = actionMenu' "dmenu" action++actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()+actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)+    where+      menuMapFunction :: M.Map String a -> X (Maybe a)+      menuMapFunction selectionMap = menuMap menuCmd selectionMap++-- | A map from window names to Windows.+windowMap :: X (M.Map String Window)+windowMap = do+  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 (,) 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/WindowGo.hs view
@@ -0,0 +1,172 @@+{- |+Module      :  XMonad.Actions.WindowGo+License     :  Public domain++Maintainer  :  <gwern0@gmail.com>+Stability   :  unstable+Portability :  unportable++Defines a few convenient operations for raising (traveling to) windows based on XMonad's Query+monad, such as 'runOrRaise'. runOrRaise will run a shell command unless it can+find a specified window; you would use this to automatically travel to your+Firefox or Emacs session, or start a new one (for example), instead of trying to+remember where you left it or whether you still have one running. -}++module XMonad.Actions.WindowGo (+                 -- * Usage+                 -- $usage+                 raise,+                 raiseNext,+                 runOrRaise,+                 runOrRaiseNext,+                 raiseMaybe,+                 raiseNextMaybe,++                 raiseBrowser,+                 raiseEditor,+                 runOrRaiseAndDo,+                 runOrRaiseMaster,+                 raiseAndDo,+                 raiseMaster,+                 module XMonad.ManageHook+                ) where++import Control.Monad (filterM)+import Data.Char (toLower)++import XMonad (Query(), X(), withWindowSet, spawn, runQuery, liftIO)+import Graphics.X11 (Window)+import XMonad.ManageHook+import XMonad.Operations (windows)+import XMonad.Prompt.Shell (getBrowser, getEditor)+import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow)+{- $usage++Import the module into your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Actions.WindowGo++and define appropriate key bindings:++> , ((modMask x .|. shiftMask, xK_g), raise (className =? "Firefox"))+> , ((modMask x .|. shiftMask, xK_b), runOrRaise "firefox" (className =? "Firefox"))++(Note that Firefox v3 and up have a class-name of \"Firefox\" and \"Navigator\";+lower versions use other classnames such as \"Firefox-bin\". Either choose the+appropriate one, or cover your bases by using instead something like+ @(className =? \"Firefox\" <||> className =? \"Firefox-bin\")@.)++For detailed instructions on editing your key bindings, see+"XMonad.Doc.Extending#Editing_key_bindings". -}++-- | 'action' is an executable to be run via 'spawn' (of "XMonad.Core") if the Window cannot be found.+--   Presumably this executable is the same one that you were looking for.+runOrRaise :: String -> Query Bool -> X ()+runOrRaise = raiseMaybe . spawn++-- | See 'raiseMaybe'. If the Window can't be found, quietly give up and do nothing.+raise :: Query Bool -> X ()+raise = raiseMaybe $ return ()++{- | 'raiseMaybe' queries all Windows based on a boolean provided by the+   user. Currently, there are three such useful booleans defined in+   "XMonad.ManageHook": title, resource, className. Each one tests based pretty+   much as you would think. ManageHook also defines several operators, the most+   useful of which is (=?). So a useful test might be finding a Window whose+   class is Firefox. Firefox 3 declares the class \"Firefox\", so you'd want to+   pass in a boolean like @(className =? \"Firefox\")@.++   If the boolean returns @True@ on one or more windows, then XMonad will quickly+   make visible the first result. If no @Window@ meets the criteria, then the+   first argument comes into play.++   The first argument is an arbitrary IO function which will be executed if the+   tests fail. This is what enables 'runOrRaise' to use 'raiseMaybe': it simply runs+   the desired program if it isn't found. But you don't have to do that. Maybe+   you want to do nothing if the search fails (the definition of 'raise'), or+   maybe you want to write to a log file, or call some prompt function, or+   something crazy like that. This hook gives you that flexibility. You can do+   some cute things with this hook. Suppose you want to do the same thing for+   Mutt which you just did for Firefox - but Mutt runs inside a terminal window?+   No problem: you search for a terminal window calling itself \"mutt\", and if+   there isn't you run a terminal with a command to run Mutt! Here's an example+   (borrowing 'runInTerm' from "XMonad.Utils.Run"):++  > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))+-}+raiseMaybe :: X () -> Query Bool -> X ()+raiseMaybe f thatUserQuery = withWindowSet $ \s -> do+    maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s)+    case maybeResult of+      []     -> f+      (x:_)  -> windows $ W.focusWindow x++-- | See 'runOrRaise' and 'raiseNextMaybe'. Version that allows cycling through matches.+runOrRaiseNext :: String -> Query Bool -> X ()+runOrRaiseNext = raiseNextMaybe . spawn++-- | See 'raise' and 'raiseNextMaybe'. Version that allows cycling through matches.+raiseNext :: Query Bool -> X ()+raiseNext = raiseNextMaybe $ return ()++{- | See 'raiseMaybe'.+     'raiseNextMaybe' is an alternative version that allows cycling+     through the matching windows. If the focused window matches the+     query the next matching window is raised. If no matches are found+     the function f is executed.+-}+raiseNextMaybe :: X () -> Query Bool -> X ()+raiseNextMaybe f thatUserQuery = withWindowSet $ \s -> do+  ws <- filterM (runQuery thatUserQuery) (W.allWindows s)+  case ws of+    []    -> f+    (x:_) -> let go (Just w) | (w `elem` ws) = next w $ cycle ws+                 go _ = windows $ W.focusWindow x+             in go $ W.peek s+  where+    next w (x:y:_) | x==w = windows $ W.focusWindow y+    next w (_:xs)         = next w xs+    next _ _ = error "raiseNextMaybe: empty list"++-- | Given a function which gets us a String, we try to raise a window with that classname,+--   or we then interpret that String as a executable name.+raiseVar :: IO String -> X ()+raiseVar getvar = liftIO getvar >>= \var -> runOrRaise var (fmap (map toLower) className =? var)++{- | 'raiseBrowser' and 'raiseEditor' grab $BROWSER and $EDITOR respectively and they either+     take you to the specified program's window, or they try to run it. This is most useful+     if your variables are simple and look like 'firefox' or 'emacs'. -}+raiseBrowser, raiseEditor :: X ()+raiseBrowser = raiseVar getBrowser+raiseEditor  = raiseVar getEditor++{- | if the window is found the window is focused and the third argument is called+     otherwise, the first argument is called+     See 'raiseMaster' for an example -}+raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()+raiseAndDo raisef thatUserQuery afterRaise = withWindowSet $ \s -> do+    maybeResult <- filterM (runQuery thatUserQuery) (W.allWindows s)+    case maybeResult of+      []     -> raisef+      (x:_)  -> do windows $ W.focusWindow x+                   afterRaise x++{- | if the window is found the window is focused and the third argument is called+     otherwise, raisef is called -}+runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()+runOrRaiseAndDo = raiseAndDo . spawn++{- | if the window is found the window is focused and set to master+     otherwise, the first argument is called++     raiseMaster (runInTerm \"-title ghci\"  \"zsh -c \'ghci\'\") (title =? \"ghci\") -}+raiseMaster :: X () -> Query Bool -> X ()+raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> windows W.swapMaster)++{- |  if the window is found the window is focused and set to master+      otherwise, action is run++      runOrRaiseMaster \"firefox\" (className =? \"Firefox\")) +  -}+runOrRaiseMaster :: String -> Query Bool -> X ()+runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster)
+ XMonad/Actions/WindowMenu.hs view
@@ -0,0 +1,59 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.WindowMenu+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Actions.WindowMenu (+                             windowMenu+                              ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Actions.GridSelect+import XMonad.Layout.Maximize+import XMonad.Layout.Minimize++simpleColorizer :: (Monad m) => t -> t -> t1 -> Bool -> m (t, [Char])+simpleColorizer nBC _ _ False  = return (nBC, "black")+simpleColorizer _ fBC _ True  = return (fBC, "black")++windowMenu :: X ()+windowMenu = withFocused $ \w -> do+    nBC <- asks (normalBorderColor . config)+    fBC <- asks (focusedBorderColor . config)+    tags <- asks (workspaces . config)+    Rectangle x y wh ht <- getSize w+    Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset+    let originFractX = (fromIntegral x - fromIntegral sx + (fromIntegral wh / 2))+                        / fromIntegral swh+        originFractY = (fromIntegral y -fromIntegral sy + (fromIntegral ht / 2))+                        / fromIntegral sht+        colorizer = simpleColorizer nBC fBC+        gsConfig = buildDefaultGSConfig colorizer+        gsConfig' = gsConfig { gs_originFractX = originFractX,+                               gs_originFractY = originFractY }+        actions = [ ("Cancel menu", return ())+                  , ("Close"      , kill)+                  , ("Maximize"   , sendMessage $ maximizeRestore w)+                  , ("Minimize"   , sendMessage $ MinimizeWin w)+                  ] +++                  [ ("Move to workspace " ++ tag, windows $ W.shift tag)+                    | tag <- tags ]+    runSelectedAction gsConfig' actions++getSize :: Window -> X (Rectangle)+getSize w = do+  d  <- asks display+  wa <- io $ getWindowAttributes d w+  let x = fromIntegral $ wa_x wa+      y = fromIntegral $ wa_y wa+      wh = fromIntegral $ wa_width wa+      ht = fromIntegral $ wa_height wa+  return (Rectangle x y wh ht)
+ XMonad/Actions/WindowNavigation.hs view
@@ -0,0 +1,214 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.WindowNavigation+-- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,+--                          Devin Mullins <me@twifkak.com>+-- Maintainer  :  Devin Mullins <me@twifkak.com>+-- License     :  BSD3-style (see LICENSE)+--+-- This is a rewrite of "XMonad.Layout.WindowNavigation".  WindowNavigation+-- lets you assign keys to move up\/down\/left\/right, based on actual cartesian+-- window coordinates, rather than just going j\/k on the stack.+--+-- This module is experimental. You'll have better luck with the original.+--+-- This module differs from the other in a few ways:+--+--   (1) You can go up\/down\/left\/right across multiple screens.+--+--   (2) It doesn't provide little border colors for your neighboring windows.+--+--   (3) It doesn't provide the \'Move\' action, which seems to be related to+--      the XMonad.Layout.Combo extension.+--+--   (4) It tries to be slightly smarter about tracking your current position.+--+--   (5) Configuration is different.+--+-----------------------------------------------------------------------------++module XMonad.Actions.WindowNavigation (+                                       -- * Usage+                                       -- $usage+                                       withWindowNavigation,+                                       withWindowNavigationKeys,+                                       WNAction(..),+                                       go, swap,+                                       Direction(..)+                                       ) where++import XMonad+import XMonad.Hooks.ManageDocks (Direction(..))+import qualified XMonad.StackSet as W++import Control.Applicative ((<$>))+import Control.Arrow (second)+import Data.IORef+import Data.List (sortBy)+import Data.Map (Map())+import qualified Data.Map as M+import Data.Maybe (catMaybes, fromMaybe, listToMaybe)+import Data.Ord (comparing)+import qualified Data.Set as S+import Graphics.X11.Xlib++-- $usage+--+-- To use it, you're going to apply the 'withWindowNavigation' function.+-- 'withWindowNavigation' performs some IO operations, so the syntax you'll use+-- is the same as the spawnPipe example in "XMonad.Hooks.DynamicLog".+-- In particular:+--+-- > main = do+-- >     config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)+-- >             $ defaultConfig { ... }+-- >     xmonad config+--+-- Here, we pass in the keys for navigation in counter-clockwise order from up.+-- It creates keybindings for @modMask@ to move to window, and @modMask .|. shiftMask@+-- to swap windows.+--+-- If you want more flexibility over your keybindings, you can use+-- 'withWindowNavigationKeys', which takes a list of @keys@-esque entries rather+-- than a tuple of the four directional keys. See the source code of+-- 'withWindowNavigation' for an example.++-- TODO:+--  - monad for WNState?+--  - cleanup (including inr)+--  - more documentation+--  - tests? (esp. for edge cases in currentPosition)+--  - screen 1, 1+2/w 3, M-d, M-w, M-2 (1+2/w 2), M-e, M-a - goes to w 3, should be w 2+--  - solve the 2+3, middle right to bottom left problem+--  - command to iteratively swapUp/swapDown instead of directly swapping with target+--  - manageHook to draw window decos?++withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)+withWindowNavigation (u,l,d,r) conf =+    withWindowNavigationKeys [ ((modMask conf              , u), WNGo   U),+                               ((modMask conf              , l), WNGo   L),+                               ((modMask conf              , d), WNGo   D),+                               ((modMask conf              , r), WNGo   R),+                               ((modMask conf .|. shiftMask, u), WNSwap U),+                               ((modMask conf .|. shiftMask, l), WNSwap L),+                               ((modMask conf .|. shiftMask, d), WNSwap D),+                               ((modMask conf .|. shiftMask, r), WNSwap R) ]+                             conf++withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)+withWindowNavigationKeys wnKeys conf = do+    posRef <- newIORef M.empty+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)+                                 `M.union` keys conf cnf,+                  logHook = logHook conf >> trackMovement posRef }+  where fromWNAction posRef (WNGo dir)   = go   posRef dir+        fromWNAction posRef (WNSwap dir) = swap posRef dir++data WNAction = WNGo Direction | WNSwap Direction++type WNState = Map WorkspaceId Point++-- go:+-- 1. get current position, verifying it matches the current window+-- 2. get target windowrect+-- 3. focus window+-- 4. set new position+go :: IORef WNState -> Direction -> X ()+go = withTargetWindow W.focusWindow++swap :: IORef WNState -> Direction -> X ()+swap = withTargetWindow swapWithFocused+  where swapWithFocused targetWin winSet =+            case W.peek winSet of+                Just currentWin -> W.focusWindow currentWin $+                                   mapWindows (swapWin currentWin targetWin) winSet+                Nothing -> winSet+        mapWindows f ss = W.mapWorkspace (mapWindows' f) ss+        mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }+        mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)+        swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win++withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X ()+withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do+    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir+    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do+      windows (adj targetWin)+      setPosition posRef pos targetRect++trackMovement :: IORef WNState -> X ()+trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do+                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)++fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()+fromCurrentPoint posRef f = withFocused $ \win -> do+                                currentPosition posRef >>= f win++-- Gets the current position from the IORef passed in, or if nothing (say, from+-- a restart), derives the current position from the current window. Also,+-- verifies that the position is congruent with the current window (say, if you+-- used mod-j/k or mouse or something).+currentPosition :: IORef WNState -> X Point+currentPosition posRef = do+    root <- asks theRoot+    currentWindow <- gets (W.peek . windowset)+    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)++    wsid <- gets (W.currentTag . windowset)+    mp <- M.lookup wsid <$> io (readIORef posRef)++    return $ maybe (middleOf currentRect) (`inside` currentRect) mp++  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)++setPosition :: IORef WNState -> Point -> Rectangle -> X ()+setPosition posRef oldPos newRect = do+    wsid <- gets (W.currentTag . windowset)+    io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)++inside :: Point -> Rectangle -> Point+Point x y `inside` Rectangle rx ry rw rh =+    Point (x `within` (rx, rw)) (y `within` (ry, rh))+  where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim+                                    then pos+                                    else midPoint lower dim++midPoint :: Position -> Dimension -> Position+midPoint pos dim = pos + fromIntegral dim `div` 2++navigableTargets :: Point -> Direction -> X [(Window, Rectangle)]+navigableTargets point dir = navigable dir point <$> windowRects++-- Filters and sorts the windows in terms of what is closest from the Point in+-- the Direction.+navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]+navigable d pt = sortby d . filter (inr d pt . snd)++-- Produces a list of normal-state windows, on any screen. Rectangles are+-- adjusted based on screen position relative to the current screen, because I'm+-- bad like that.+windowRects :: X [(Window, Rectangle)]+windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped++windowRect :: Window -> X (Maybe (Window, Rectangle))+windowRect win = withDisplay $ \dpy -> do+    (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win+    return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))+    `catchX` return Nothing++-- Modified from droundy's implementation of WindowNavigation:++inr :: Direction -> Point -> Rectangle -> Bool+inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&+                                                        py < ry + fromIntegral h+inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&+                                            py >  ry+inr R (Point px py) (Rectangle rx ry _ h) = px <  rx &&+                                            py >= ry && py < ry + fromIntegral h+inr L (Point px py) (Rectangle rx ry w h) =             px > rx + fromIntegral w &&+                                            py >= ry && py < ry + fromIntegral h++sortby :: Direction -> [(a,Rectangle)] -> [(a,Rectangle)]+sortby D = sortBy $ comparing (rect_y . snd)+sortby R = sortBy $ comparing (rect_x . snd)+sortby U = reverse . sortby D+sortby L = reverse . sortby R
+ XMonad/Actions/WithAll.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Actions.WithAll+-- License      : BSD3-style (see LICENSE)+-- Stability    : unstable+-- Portability  : unportable+--+-- Provides functions for performing a given action on all windows of+-- the current workspace.+-----------------------------------------------------------------------------++module XMonad.Actions.WithAll (+    -- * Usage+    -- $usage+    sinkAll, withAll,+    withAll', killAll) where++import Data.Foldable hiding (foldr)++import XMonad+import XMonad.Core+import XMonad.Operations+import XMonad.StackSet++-- $usage+--+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.WithAll+--+-- 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 the current workspace.+withAll' :: (Window -> WindowSet -> WindowSet) -> X ()+withAll' f = windows $ \ws -> let all' = integrate' . stack . workspace . current $ ws+                              in foldr f ws all'++-- | Execute an 'X' action for each window on the current workspace.+withAll :: (Window -> X ()) -> X()+withAll f = withWindowSet $ \ws -> let all' = integrate' . stack . workspace . current $ ws+                                   in forM_ all' f++-- | Kill all the windows on the current workspace.+killAll :: X()+killAll = withAll killWindow
+ XMonad/Config/Arossato.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -fglasgow-exts -fno-warn-missing-signatures #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Config.Arossato+-- Copyright   :  (c) Andrea Rossato 2007+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  stable+-- Portability :  portable+--+-- This module specifies my xmonad defaults.+--+------------------------------------------------------------------------++module XMonad.Config.Arossato+    ( -- * Usage+      -- $usage+      arossatoConfig+    ) where++import qualified Data.Map as M++import XMonad hiding ( (|||) )+import qualified XMonad.StackSet as W++import XMonad.Actions.CycleWS+import XMonad.Hooks.DynamicLog hiding (xmobar)+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.ServerMode+import XMonad.Layout.Accordion+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.Magnifier+import XMonad.Layout.NoBorders+import XMonad.Layout.SimpleFloat+import XMonad.Layout.Tabbed+import XMonad.Layout.WindowArranger+import XMonad.Prompt+import XMonad.Prompt.Shell+import XMonad.Prompt.Ssh+import XMonad.Prompt.Theme+import XMonad.Prompt.Window+import XMonad.Prompt.XMonad+import XMonad.Util.Run+import XMonad.Util.Themes++-- $usage+-- The simplest way to use this configuration module is to use an+-- @~\/.xmonad\/xmonad.hs@ like this:+--+-- > module Main (main) where+-- >+-- > import XMonad+-- > import XMonad.Config.Arossato (arossatoConfig)+-- >+-- > main :: IO ()+-- > main = xmonad =<< arossatoConfig+--+-- NOTE: that I'm using xmobar and, if you don't have xmobar in your+-- PATH, this configuration will produce an error and xmonad will not+-- start. If you don't want to install xmobar get rid of this line at+-- the beginning of 'arossatoConfig'.+--+-- You can use this module also as a starting point for writing your+-- own configuration module from scratch. Save it as your+-- @~\/.xmonad\/xmonad.hs@ and:+--+-- 1. Change the module name from+--+-- > module XMonad.Config.Arossato+-- >     ( -- * Usage+-- >       -- $usage+-- >       arossatoConfig+-- >     ) where+--+-- to+--+-- > module Main where+--+-- 2. Add a line like:+--+-- > main = xmonad =<< arossatoConfig+--+-- 3. Start playing with the configuration options...;)++arossatoConfig = do+    xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed!+    return $ defaultConfig+         { workspaces         = ["home","var","dev","mail","web","doc"] +++                                map show [7 .. 9 :: Int]+         , logHook            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!+         , manageHook         = newManageHook+         , layoutHook         = avoidStruts $+                                decorated        |||+                                noBorders mytabs |||+                                otherLays+         , terminal           = "urxvt +sb"+         , normalBorderColor  = "white"+         , focusedBorderColor = "black"+         , keys               = newKeys+         , handleEventHook    = serverModeEventHook+         , focusFollowsMouse  = False+         }+    where+      -- layouts+      mytabs    =       tabbed shrinkText (theme smallClean)+      decorated = simpleFloat' shrinkText (theme smallClean)+      tiled     = Tall 1 (3/100) (1/2)+      otherLays = windowArrange   $+                  magnifier tiled |||+                  noBorders Full  |||+                  Mirror tiled    |||+                  Accordion++      -- manageHook+      myManageHook  = composeAll [ resource =? "win"          --> doF (W.shift "doc") -- xpdf+                                 , resource =? "firefox-bin"  --> doF (W.shift "web")+                                 ]+      newManageHook = myManageHook++      -- xmobar+      myDynLog    h = dynamicLogWithPP defaultPP+                      { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"+                      , ppTitle   = xmobarColor "green"  "" . shorten 40+                      , ppVisible = wrap "(" ")"+                      , ppOutput  = hPutStrLn h+                      }++      -- key bindings stuff+      defKeys    = keys defaultConfig+      delKeys x  = foldr M.delete           (defKeys x) (toRemove x)+      newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)+      -- remove some of the default key bindings+      toRemove x =+          [ (modMask x              , xK_j)+          , (modMask x              , xK_k)+          , (modMask x              , xK_p)+          , (modMask x .|. shiftMask, xK_p)+          , (modMask x .|. shiftMask, xK_q)+          , (modMask x              , xK_q)+          ] +++          -- I want modMask .|. shiftMask 1-9 to be free!+          [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]+      -- These are my personal key bindings+      toAdd x   =+          [ ((modMask x              , xK_F12   ), xmonadPrompt      defaultXPConfig     )+          , ((modMask x              , xK_F3    ), shellPrompt       defaultXPConfig     )+          , ((modMask x              , xK_F4    ), sshPrompt         defaultXPConfig     )+          , ((modMask x              , xK_F5    ), themePrompt       defaultXPConfig     )+          , ((modMask x              , xK_F6    ), windowPromptGoto  defaultXPConfig     )+          , ((modMask x              , xK_F7    ), windowPromptBring defaultXPConfig     )+          , ((modMask x              , xK_comma ), prevWS                                )+          , ((modMask x              , xK_period), nextWS                                )+          , ((modMask x              , xK_Right ), windows W.focusDown                   )+          , ((modMask x              , xK_Left  ), windows W.focusUp                     )+          -- other stuff: launch some useful utilities+          , ((modMask x              , xK_F2    ), spawn "urxvt -fg white -bg black +sb" )+          , ((modMask x .|. shiftMask, xK_F4    ), spawn "~/bin/dict.sh"                 )+          , ((modMask x .|. shiftMask, xK_F5    ), spawn "~/bin/urlOpen.sh"              )+          , ((modMask x .|. shiftMask, xK_t     ), spawn "~/bin/teaTime.sh"              )+          , ((modMask x              , xK_c     ), kill                                  )+          , ((modMask x .|. shiftMask, xK_comma ), sendMessage (IncMasterN   1 )         )+          , ((modMask x .|. shiftMask, xK_period), sendMessage (IncMasterN (-1))         )+          -- commands fo the Magnifier layout+          , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)+          , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)+          , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )+          , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )+          -- windowArranger+          , ((modMask x .|. controlMask              , xK_a    ), sendMessage  Arrange           )+          , ((modMask x .|. controlMask .|. shiftMask, xK_a    ), sendMessage  DeArrange         )+          , ((modMask x .|. controlMask              , xK_Left ), sendMessage (DecreaseLeft   10))+          , ((modMask x .|. controlMask              , xK_Up   ), sendMessage (DecreaseUp     10))+          , ((modMask x .|. controlMask              , xK_Right), sendMessage (IncreaseRight  10))+          , ((modMask x .|. controlMask              , xK_Down ), sendMessage (IncreaseDown   10))+          , ((modMask x .|. shiftMask                , xK_Left ), sendMessage (MoveLeft       10))+          , ((modMask x .|. shiftMask                , xK_Right), sendMessage (MoveRight      10))+          , ((modMask x .|. shiftMask                , xK_Down ), sendMessage (MoveDown       10))+          , ((modMask x .|. shiftMask                , xK_Up   ), sendMessage (MoveUp         10))+          -- gaps+          , ((modMask x                              , xK_b    ), sendMessage  ToggleStruts      )++          ] +++          -- Use modMask .|. shiftMask .|. controlMask 1-9 instead+          [( (m .|. modMask x, k), windows $ f i)+           | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]+          ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]+          ]
+ XMonad/Config/Azerty.hs view
@@ -0,0 +1,46 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Config.Azerty+-- Copyright    : (c) Devin Mullins <me@twifkak.com>+-- License      : BSD+--+-- Maintainer   : Devin Mullins <me@twifkak.com>+--+-- This module fixes some of the keybindings for the francophone among you who+-- use an AZERTY keyboard layout. Config stolen from TeXitoi's config on the+-- wiki.++module XMonad.Config.Azerty (+    -- * Usage+    -- $usage+    azertyConfig, azertyKeys+    ) where++import XMonad+import qualified XMonad.StackSet as W++import qualified Data.Map as M++-- $usage+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Config.Azerty+-- >+-- > main = xmonad azertyConfig+--+-- If you prefer, an azertyKeys function is provided which you can use as so:+--+-- > import qualified Data.Map as M+-- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }++azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }++azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $+    [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]+    +++    [((m .|. modm, k), windows $ f i)+        | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],+          (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+ XMonad/Config/Desktop.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Config.Desktop+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License      : BSD+--+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>+--+-- This module provides a config suitable for use with a desktop+-- environment such as KDE or GNOME.++module XMonad.Config.Desktop (+    desktopConfig,+    desktopLayoutModifiers+    ) where++import XMonad+import XMonad.Config (defaultConfig)+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.EwmhDesktops++import qualified Data.Map as M++desktopConfig = defaultConfig+    { logHook    = ewmhDesktopsLogHook+    , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig+    , manageHook = manageHook defaultConfig <+> manageDocks+    , handleEventHook = ewmhDesktopsEventHook+    , keys       = \c -> desktopKeys c `M.union` keys defaultConfig c }++desktopKeys (XConfig {modMask = modm}) = M.fromList $+    [ ((modm, xK_b), sendMessage ToggleStruts) ]++desktopLayoutModifiers layout = avoidStruts layout
+ XMonad/Config/Droundy.hs view
@@ -0,0 +1,186 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (c) Spencer Janssen 2007+-- License     :  BSD3-style (see LICENSE)+--+------------------------------------------------------------------------++module XMonad.Config.Droundy ( config, mytab ) where++import XMonad hiding (keys, config, (|||))+import qualified XMonad (keys)+import XMonad.Config ( defaultConfig )++import qualified XMonad.StackSet as W+import qualified Data.Map as M+import System.Exit ( exitWith, ExitCode(ExitSuccess) )++import XMonad.Layout.Tabbed ( tabbed, defaultTheme,+                              shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )+import XMonad.Layout.Combo ( combineTwo )+import XMonad.Layout.Named ( named )+import XMonad.Layout.LayoutCombinators+import XMonad.Layout.Square ( Square(Square) )+import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction(U,D,R,L),+                                        windowNavigation )+import XMonad.Layout.BoringWindows ( boringWindows, markBoring, clearBoring,+                                     focusUp, focusDown )+import XMonad.Layout.NoBorders ( smartBorders )+import XMonad.Layout.WorkspaceDir ( changeDir, workspaceDir )+import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )+import XMonad.Layout.ShowWName ( showWName )+import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )++import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )+import XMonad.Prompt.Layout ( layoutPrompt )+import XMonad.Prompt.Shell ( shellPrompt )++import XMonad.Actions.CopyWindow ( kill1, copy )+import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,+                                          selectWorkspace, renameWorkspace, removeWorkspace )+import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),+                                WSDirection( Prev, Next) )++import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )+import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,+                                   ewmhDesktopsEventHook )++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 .|. shiftMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms+    , ((modMask x .|. controlMask .|. shiftMask, xK_L ), setLayout $ layoutHook x) -- %!  Reset the layouts on the current workspace to default++    -- move focus up or down the window stack+    , ((modMask x,               xK_Tab   ), focusDown) -- %! Move focus to the next window+    , ((modMask x,               xK_j     ), focusDown) -- %! Move focus to the next window+    , ((modMask x,               xK_k     ), focusUp  ) -- %! Move focus to the previous window++    , ((modMask x .|. shiftMask, xK_j     ), windows W.swapDown  ) -- %! Swap the focused window with the next window+    , ((modMask x .|. shiftMask, xK_k     ), windows W.swapUp    ) -- %! Swap the focused window with the previous window++    -- floating layer support+    , ((modMask x,               xK_t     ), withFocused $ windows . W.sink) -- %! Push window back into tiling++    -- quit, or restart+    , ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad+    , ((modMask x              , xK_Escape), restart "xmonad" True) -- %! Restart xmonad++    , ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)+    , ((modMask x .|. shiftMask, xK_Left), moveTo Prev HiddenNonEmptyWS)+    , ((modMask x, xK_Right), sendMessage $ Go R)+    , ((modMask x, xK_Left), sendMessage $ Go L)+    , ((modMask x, xK_Up), sendMessage $ Go U)+    , ((modMask x, xK_Down), sendMessage $ Go D)+    , ((modMask x .|. controlMask, xK_Right), sendMessage $ Swap R)+    , ((modMask x .|. controlMask, xK_Left), sendMessage $ Swap L)+    , ((modMask x .|. controlMask, xK_Up), sendMessage $ Swap U)+    , ((modMask x .|. controlMask, xK_Down), sendMessage $ Swap D)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Left), sendMessage $ Move L)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Up), sendMessage $ Move U)+    , ((modMask x .|. controlMask .|. shiftMask, xK_Down), sendMessage $ Move D)+ +    , ((0, xK_F2  ), spawn "gnome-terminal") -- %! Launch gnome-terminal+    , ((0, xK_F3  ), shellPrompt myXPConfig) -- %! Launch program+    , ((0, xK_F11   ), spawn "ksnapshot") -- %! Take snapshot+    , ((modMask x .|. shiftMask, xK_b     ), markBoring)+    , ((controlMask .|. modMask x .|. shiftMask, xK_b     ), clearBoring)+    , ((modMask x .|. shiftMask, xK_x     ), changeDir myXPConfig)+    , ((modMask x .|. shiftMask, xK_BackSpace), removeWorkspace)+    , ((modMask x .|. shiftMask, xK_v     ), selectWorkspace myXPConfig)+    , ((modMask x, xK_m     ), withWorkspace myXPConfig (windows . W.shift))+    , ((modMask x .|. shiftMask, xK_m     ), withWorkspace myXPConfig (windows . copy))+    , ((modMask x .|. shiftMask, xK_r), renameWorkspace myXPConfig)+    , ((modMask x, xK_l ), layoutPrompt myXPConfig)+    , ((modMask x .|. controlMask, xK_space), sendMessage ToggleLayout)+    , ((modMask x, xK_space), sendMessage Toggle)++    ]+ +    +++    zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])+    +++    zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])++config = defaultConfig+         { borderWidth = 1 -- Width of the window border in pixels.+         , XMonad.workspaces = ["mutt","iceweasel"]+         , layoutHook = showWName $ workspaceDir "~" $+                        boringWindows $ smartBorders $ windowNavigation $+                        maximizeVertical $ toggleLayouts Full $ avoidStruts $+                        named "tabbed" mytab |||+                        named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||+                        named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||+                        named "widescreen" ((mytab *||* mytab)+                                                ****//* combineTwo Square mytab mytab) --   |||+                        --mosaic 0.25 0.5+         , manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling+         , logHook = ewmhDesktopsLogHook -- actually, no logging here, just other stuff+         , terminal = "xterm" -- The preferred terminal program.+         , normalBorderColor = "#222222" -- Border color for unfocused windows.+         , focusedBorderColor = "#00ff00" -- Border color for focused windows.+         , handleEventHook = ewmhDesktopsEventHook+         , XMonad.modMask = mod1Mask+         , XMonad.keys = keys+         }++mytab = tabbed CustomShrink defaultTheme++instance Shrinker CustomShrink where+    shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail " " s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail "- Iceweasel" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromTail "- KPDF" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromHead "file://" s = shrinkIt shr s' +    shrinkIt shr s | Just s' <- dropFromHead "http://" s = shrinkIt shr s' +    shrinkIt _ s | n > 9 = s : map cut [2..(halfn-3)] ++ shrinkIt shrinkText s+                 where n = length s+                       halfn = n `div` 2+                       rs = reverse s+                       cut x = take (halfn - x) s ++ "..." ++ reverse (take (halfn-x) rs)+    shrinkIt _ s = shrinkIt shrinkText s++dropFromTail :: String -> String -> Maybe String+dropFromTail "" _ = Nothing+dropFromTail t s | drop (length s - length t) s == t = Just $ take (length s - length t) s+                 | otherwise = Nothing++dropFromHead :: String -> String -> Maybe String+dropFromHead "" _ = Nothing+dropFromHead h s | take (length h) s == h = Just $ drop (length h) s+                 | otherwise = Nothing++{-+data FocusUrgencyHook = FocusUrgencyHook deriving (Read, Show)++instance UrgencyHook FocusUrgencyHook Window where+    urgencyHook _ w = modify copyAndFocus+        where copyAndFocus s+                  | Just w == W.peek (windowset s) = s+                  | has w $ W.stack $ W.workspace $ W.current $ windowset s =+                      s { windowset = until ((Just w ==) . W.peek)+                                      W.focusUp $ windowset s }+                  | otherwise =+                      let t = W.currentTag $ 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/Gnome.hs view
@@ -0,0 +1,55 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Config.Gnome+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License      : BSD+--+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>+--+-- This module provides a config suitable for use with the GNOME desktop+-- environment.++module XMonad.Config.Gnome (+    -- * Usage+    -- $usage+    gnomeConfig,+    gnomeRun+    ) where++import XMonad+import XMonad.Config.Desktop++import qualified Data.Map as M++-- $usage+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Config.Gnome+-- >+-- > main = xmonad gnomeConfig+-- ++gnomeConfig = desktopConfig+    { terminal = "gnome-terminal"+    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c }++gnomeKeys (XConfig {modMask = modm}) = M.fromList $+    [ ((modm, xK_p), gnomeRun)+    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]++-- | Launch the "Run Application" dialog.  gnome-panel must be running for this+-- to work.+gnomeRun :: X ()+gnomeRun = withDisplay $ \dpy -> do+    rw <- asks theRoot+    gnome_panel <- getAtom "_GNOME_PANEL_ACTION"+    panel_run   <- getAtom "_GNOME_PANEL_ACTION_RUN_DIALOG"++    io $ allocaXEvent $ \e -> do+        setEventType e clientMessage+        setClientMessageEvent e rw gnome_panel 32 panel_run 0+        sendEvent dpy rw False structureNotifyMask e+        sync dpy False
+ XMonad/Config/Kde.hs view
@@ -0,0 +1,53 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Config.Kde+-- Copyright    : (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License      : BSD+--+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>+--+-- This module provides a config suitable for use with the KDE desktop+-- environment.++module XMonad.Config.Kde (+    -- * Usage+    -- $usage+    kdeConfig,+    kde4Config+    ) where++import XMonad+import XMonad.Config.Desktop++import qualified Data.Map as M++-- $usage+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Config.Kde+-- >+-- > main = xmonad kdeConfig+--+-- For KDE 4, replace 'kdeConfig' with 'kde4Config'+-- ++kdeConfig = desktopConfig+    { terminal = "konsole"+    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }++kde4Config = desktopConfig+    { terminal = "konsole"+    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }++kdeKeys (XConfig {modMask = modm}) = M.fromList $+    [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")+    , ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")+    ]++kde4Keys (XConfig {modMask = modm}) = M.fromList $+    [ ((modm,               xK_p), spawn "krunner")+    , ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")+    ]
+ XMonad/Config/Sjanssen.hs view
@@ -0,0 +1,65 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+module XMonad.Config.Sjanssen (sjanssenConfig, sjanssenConfigXmobar) 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 hiding (xmobar)+import XMonad.Hooks.ManageDocks+import XMonad.Hooks.EwmhDesktops+import XMonad.Prompt+import XMonad.Actions.SpawnOn++import XMonad.Layout.LayoutScreens+import XMonad.Layout.TwoPane++import qualified Data.Map as M++sjanssenConfigXmobar = statusBar "xmobar" sjanssenPP strutkey =<< sjanssenConfig+ where+    strutkey (XConfig {modMask = modm}) = (modm, xK_b)++sjanssenConfig = do+    sp <- mkSpawner+    return $ defaultConfig+        { terminal = "urxvtc"+        , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]+        , 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 sp c `M.union` keys defaultConfig c+        , layoutHook = modifiers layouts+        , logHook    = ewmhDesktopsLogHook+        , manageHook = composeAll [className =? x --> doShift w+                                    | (x, w) <- [ ("Firefox", "web")+                                                , ("Ktorrent", "7")+                                                , ("Amarokapp", "7")]]+                       <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn sp+        }+ where+    tiled     = HintedTile 1 0.03 0.5 TopLeft+    layouts   = (tiled Tall ||| (tiled Wide ||| Full)) ||| tabbed shrinkText myTheme+    modifiers = smartBorders++    mykeys sp (XConfig {modMask = modm, workspaces = ws}) = M.fromList $+        [((modm,               xK_p     ), shellPromptHere sp myPromptConfig)+        ,((modm .|. shiftMask, xK_c     ), kill1)+        ,((modm .|. shiftMask .|. controlMask, xK_c     ), kill)+        ,((modm .|. shiftMask, xK_0     ), windows $ \w -> foldr copy w ws)+        ,((modm,               xK_z     ), layoutScreens 2 $ TwoPane 0.5 0.5)+        ,((modm .|. shiftMask, xK_z     ), rescreen)+        ]++    myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"+    myTheme = defaultTheme { fontName = myFont }+    myPromptConfig = defaultXPConfig+                        { position = Top+                        , font = myFont+                        , showCompletionOnTab = True+                        , historyFilter = deleteConsecutive+                        , promptBorderWidth = 0 }
+ XMonad/Config/Xfce.hs view
@@ -0,0 +1,42 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Config.Xfce+-- Copyright    : (c) Ivan Miljenovic <Ivan.Miljenovic@gmail.com>+-- License      : BSD+--+-- Maintainer   : Ivan Miljenovic <Ivan.Miljenovic@gmail.com>+--+-- This module provides a config suitable for use with the Xfce desktop+-- environment.++module XMonad.Config.Xfce (+    -- * Usage+    -- $usage+    xfceConfig+    ) where++import XMonad+import XMonad.Config.Desktop++import qualified Data.Map as M++-- $usage+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Config.Xfce+-- >+-- > main = xmonad xfceConfig+-- ++xfceConfig = desktopConfig+    { terminal = "Terminal"+    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }++xfceKeys (XConfig {modMask = modm}) = M.fromList $+    [ ((modm,               xK_p), spawn "xfrun4")+    , ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")+    , ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")+    ]
+ 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: a brief code commentary+    -- $developing++    ) where++import XMonad.Doc.Configuring ()+import XMonad.Doc.Extending ()+import XMonad.Doc.Developing ()++--------------------------------------------------------------------------------+--+--  Overview+--+--------------------------------------------------------------------------------++{- $overview+#Overview#++xmonad is a tiling window manager for X. The xmonad-contrib library+collects third party tiling algorithms, hooks, configurations,+scripts, and other extensions to xmonad.  The source for this library+is available from <http://code.haskell.org/XMonadContrib> via darcs:++> darcs get http://code.haskell.org/XMonadContrib++Each stable release of xmonad is accompanied by a stable release of+the contrib library, which you should use if (and only if) you're+using a stable release of xmonad.  You can find the most recent+tarball here:+<http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib>++-}++{- $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,141 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Configuring+-- Copyright   :  (C) 2007 Don Stewart and Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This is a brief tutorial that will teach you how to create a+-- basic xmonad configuration.+--+-- For more detailed instructions on extending xmonad with the+-- xmonad-contrib library, see "XMonad.Doc.Extending".+--+-----------------------------------------------------------------------------++module XMonad.Doc.Configuring+    (+    -- * Configuring xmonad+    -- $configure++    -- * A simple example+    -- $example++    -- * Checking whether your xmonad.hs is correct+    -- $check++    -- * Loading your configuration+    -- $load++    ) where++--------------------------------------------------------------------------------+--+--  Configuring Xmonad+--+--------------------------------------------------------------------------------++{- $configure+#Configuring_xmonad#+xmonad can be configured by creating and editing the Haskell file:++>    ~/.xmonad/xmonad.hs++If this file does not exist, xmonad will simply use default settings;+if it does exist, xmonad will use whatever settings you specify.  Note+that this file can contain arbitrary Haskell code, which means that+you have quite a lot of flexibility in configuring xmonad.++NOTE for users of previous versions (< 0.5) of xmonad: this is a major+change in the way xmonad is configured.  Prior to version 0.5,+configuring xmonad required editing an xmonad source file called+Config.hs, recompiling xmonad, and then restarting.  From version 0.5+onwards, however, you should NOT edit this file.  All you have to do+is edit xmonad.hs and restart with @mod-q@; xmonad does the+recompiling itself.  The format of the configuration file has also+changed; it is now simpler and much shorter, only requiring you to+list those settings which are different from the defaults.++-}++{- $example+#A_simple_example#++Here is a basic example, which starts with the default xmonad+configuration and overrides the border width, default terminal, and+some colours:++>    --+>    -- An example, simple ~/.xmonad/xmonad.hs file.+>    -- It overrides a few basic settings, reusing all the other defaults.+>    --+>+>    import XMonad+>+>    main = xmonad $ defaultConfig+>        { borderWidth        = 2+>        , terminal           = "urxvt"+>        , normalBorderColor  = "#cccccc"+>        , focusedBorderColor = "#cd8b00" }++This will run \'xmonad\', the window manager, with your settings+passed as arguments.++Overriding default settings like this (using \"record update+syntax\"), will yield the shortest config file, as you only have to+describe values that differ from the defaults.++As an alternative, you can copy the template @xmonad.hs@ file (found+either in the @man@ directory, if you have the xmonad source, or on+the xmonad wiki at+@http:\/\/haskell.org\/haskellwiki\/Xmonad\/Config_archive\/Template_xmonad.hs@)+into your @~\/.xmonad\/@ directory.  This template file contains all+the default settings spelled out, and you should be able to simply+change the ones you would like to change.++To see what fields can be customized beyond the ones in the example+above, the definition of the 'XMonad.Core.XConfig' data structure can+be found in "XMonad.Core".++-}++{- $check+#Checking_whether_your_xmonad.hs_is_correct#++After changing your configuration, it is a good idea to check that it+is syntactically and type correct.  You can do this easily by using an xmonad+flag:++>    $ xmonad --recompile+>    $++If there is no output, your xmonad.hs has no errors.  If there are errors, they+will be printed to the console.  Patch them up and try again.++Note, however, that if you skip this step and try restarting xmonad+with errors in your xmonad.hs, it's not the end of the world; xmonad+will simply display a window showing the errors and continue with the+previous configuration settings. (This assumes that you have the+\'xmessage\' utility installed; you probably do.)++-}++{- $load+#Loading_your_configuration#++To get xmonad to use your new settings, type @mod-q@. (Remember, the+mod key is \'alt\' by default, but you can configure it to be+something else, such as your Windows key if you have one.) xmonad will+attempt to compile this file, and run it.  If everything goes well,+xmonad will seamlessly restart itself with the new settings, keeping+all your windows, layouts, etc. intact.  (If you change anything+related to your layouts, you may need to hit @mod-shift-space@ after+restarting to see the changes take effect.)  If something goes wrong,+the previous (default) settings will be used.  Note this requires that+GHC and xmonad are in your @$PATH@.++-}+
+ XMonad/Doc/Developing.hs view
@@ -0,0 +1,303 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Developing+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This module gives a brief overview of the xmonad internals. It is+-- intended for advanced users who are curious about the xmonad source+-- code and want an brief overview. This document may also be helpful+-- for the beginner\/intermediate Haskell programmer who is motivated+-- to write an xmonad extension as a way to deepen her understanding+-- of this powerful functional language; however, there is not space+-- here to go into much detail.  For a more comprehensive document+-- covering some of the same material in more depth, see the guided+-- tour of the xmonad source on the xmonad wiki:+-- <http://haskell.org/haskellwiki/Xmonad/Guided_tour_of_the_xmonad_source>.+--+-- If you write an extension module and think it may be useful for+-- others, consider releasing it.  Coding guidelines and licensing+-- policies are covered at the end of this document, and must be+-- followed if you want your code to be included in the official+-- repositories.  For a basic tutorial on the nuts and bolts of+-- developing a new extension for xmonad, see the tutorial on the+-- wiki:+-- <http://haskell.org/haskellwiki/Xmonad/xmonad_development_tutorial>.+--+-----------------------------------------------------------------------------++module XMonad.Doc.Developing+    (+    -- * Writing new extensions+    -- $writing++    -- * Libraries for writing window managers+    -- $xmonad-libs++    -- * xmonad internals+    -- $internals++    -- ** The @main@ entry point+    -- $main++    -- ** The X monad and the internal state+    -- $internalState++    -- ** Event handling and messages+    -- $events++    -- ** The 'LayoutClass'+    -- $layoutClass++    -- * Coding style+    -- $style++    -- * Licensing policy+    -- $license+    ) where++--------------------------------------------------------------------------------+--+--  Writing Extensions+--+--------------------------------------------------------------------------------++{- $writing+-}++{- $xmonad-libs++Starting with version 0.5, xmonad and xmonad-contrib are packaged and+distributed as libraries, instead of components which must be compiled+by the user into a binary (as they were prior to version 0.5). This+way of distributing xmonad has many advantages, since it allows+packaging by GNU\/Linux distributions while still allowing the user to+customize the window manager to fit her needs.++Basically, xmonad and the xmonad-contrib libraries let users write+their own window manager in just a few lines of code. While+@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration+file, it is actually a complete Haskell program which uses the xmonad+and xmonad-contrib libraries to create a custom window manager.++This makes it possible not only to edit the default xmonad+configuration, as we have seen in the "XMonad.Doc.Extending" document,+but to use the Haskell programming language to extend the window+manager you are writing in any way you see fit.++-}++{- $internals+-}++{- $main+#The_main_entry_point#++xmonad installs a binary, @xmonad@, which must be executed by the+Xsession starting script. This binary, whose code can be read in+@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile'+to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@.+If this compilation process fails, for any reason, a default @main@+entry point will be used, which calls the 'XMonad.Main.xmonad'+function with a default configuration.++Thus, the real @main@ entry point, the one that even the users' custom+window manager application in @~\/.xmonad\/xmonad.hs@ must call, is+the 'XMonad.Main.xmonad' function. This function takes a configuration+as its only argument, whose type ('XMonad.Core.XConfig')+is defined in "XMonad.Core".++'XMonad.Main.xmonad' takes care of opening the connection with the X+server, initializing the state (or deserializing it when restarted)+and the configuration, and calling the event handler+('XMonad.Main.handle') that goes into an infinite loop (using+'Prelude.forever') waiting for events and acting accordingly.++-}++{- $internalState++The event loop which calls 'XMonad.Main.handle' to react to events is+run within the 'XMonad.Core.X' monad, which is a+'Control.Monad.State.StateT' transformer over 'IO', encapsulated+within a 'Control.Monad.Reader.ReaderT' transformer. The+'Control.Monad.State.StateT' transformer encapsulates the+(read\/writable) state of the window manager (of type+'XMonad.Core.XState'), whereas the 'Control.Monad.Reader.ReaderT'+transformer encapsulates the (read-only) configuration (of type+'XMonad.Core.XConf').++Thanks to GHC's newtype deriving feature, the instance of the+'Control.Monad.State.MonadState' class parametrized over+'XMonad.Core.XState' and the instance of the+'Control.Monad.Reader.MonadReader' class parametrized over+'XMonad.Core.XConf' are automatically derived for the 'XMonad.Core.X'+monad. This way we can use 'Control.Monad.State.get',+'Control.Monad.State.gets' and 'Control.Monad.State.modify' for the+'XMonad.Core.XState', and 'Control.Monad.Reader.ask' and+'Control.Monad.Reader.asks' for reading the 'XMonad.Core.XConf'.++'XMonad.Core.XState' is where all the sensitive information about+window management is stored. The most important field of the+'XMonad.Core.XState' is the 'XMonad.Core.windowset', whose type+('XMonad.Core.WindowSet') is a synonym for a+'XMonad.StackSet.StackSet' parametrized over a+'XMonad.Core.WorkspaceID' (a 'String'), a layout type wrapped inside+the 'XMonad.Layout.Layout' existential data type, the+'Graphics.X11.Types.Window' type, the 'XMonad.Core.ScreenID' and the+'XMonad.Core.ScreenDetail's.++What a 'XMonad.StackSet.StackSet' is and how it can be manipulated+with pure functions is described in the Haddock documentation of the+"XMonad.StackSet" module.++The 'XMonad.StackSet.StackSet' ('XMonad.Core.WindowSet') has four+fields:++* 'XMonad.StackSet.current', for the current, focused workspace. This+  is a 'XMonad.StackSet.Screen', which is composed of a+  'XMonad.StackSet.Workspace' together with the screen information (for+  Xinerama support).++* 'XMonad.StackSet.visible', a list of 'XMonad.StackSet.Screen's for+  the other visible (with Xinerama) workspaces.  For non-Xinerama+  setups, this list is always empty.++* 'XMonad.StackSet.hidden', the list of non-visible+  'XMonad.StackSet.Workspace's.++* 'XMonad.StackSet.floating', a map from floating+  'Graphics.X11.Types.Window's to 'XMonad.StackSet.RationalRect's+  specifying their geometry.++The 'XMonad.StackSet.Workspace' type is made of a+'XMonad.StackSet.tag', a 'XMonad.StackSet.layout' and+a (possibly empty) 'XMonad.StackSet.stack' of windows.++"XMonad.StackSet" (which should usually be imported qualified, to+avoid name clashes with Prelude functions such as 'Prelude.delete' and+'Prelude.filter') provides many pure functions to manipulate the+'XMonad.StackSet.StackSet'. These functions are most commonly used as+an argument to 'XMonad.Operations.windows', which takes a pure+function to manipulate the 'XMonad.Core.WindowSet' and does all the+needed operations to refresh the screen and save the modified+'XMonad.Core.XState'.++During each 'XMonad.Operations.windows' call, the+'XMonad.StackSet.layout' field of the 'XMonad.StackSet.current' and+'XMonad.StackSet.visible' 'XMonad.StackSet.Workspace's are used to+physically arrange the 'XMonad.StackSet.stack' of windows on each+workspace.++The possibility of manipulating the 'XMonad.StackSet.StackSet'+('XMonad.Core.WindowSet') with pure functions makes it possible to+test all the properties of those functions with QuickCheck, providing+greater reliability of the core code. Every change to the+"XMonad.StackSet" module must be accompanied by appropriate QuickCheck+properties before being applied.++-}++{- $events++Event handling is the core activity of xmonad.  Events generated by+the X server are most important, but there may also be events+generated by layouts or the user.++"XMonad.Core" defines a class that generalizes the concept of events,+'XMonad.Core.Message', constrained to types with a+'Data.Typeable.Typeable' instance definition (which can be+automatically derived by GHC). 'XMonad.Core.Message's are wrapped+within an existential type 'XMonad.Core.SomeMessage'. The+'Data.Typeable.Typeable' constraint allows for the definition of a+'XMonad.Core.fromMessage' function that can unwrap the message with+'Data.Typeable.cast'.  X Events are instances of this class, along+with any messages used by xmonad itself or by extension modules.++Using the 'Data.Typeable.Typeable' class for any kind of+'XMonad.Core.Message's and events allows us to define polymorphic functions+for processing messages or unhandled events.++This is precisely what happens with X events: xmonad passes them to+'XMonad.Main.handle'. If the main event handling function doesn't have+anything to do with the event, the event is sent to all visible+layouts by 'XMonad.Operations.broadcastMessage'.++This messaging system allows the user to create new message types,+simply declare an instance of the 'Data.Typeable.Typeable' and use+'XMonad.Operations.sendMessage' to send commands to layouts.++And, finally, layouts may handle X events and other messages within the+same function... miracles of polymorphism.++-}++{- $layoutClass+#The_LayoutClass#+to do+-}++{- $style++These are the coding guidelines for contributing to xmonad and the+xmonad contributed extensions.++* Comment every top level function (particularly exported funtions), and+  provide a type signature.++* Use Haddock syntax in the comments (see below).++* Follow the coding style of the other modules.++* Code should be compilable with "ghc-options: -Wall -Werror" set in the+xmonad-contrib.cabal file. There should be no warnings.++* Partial functions should be avoided: the window manager should not+  crash, so never call 'error' or 'undefined'.++* Tabs are /illegal/. Use 4 spaces for indenting.++* Any pure function added to the core must have QuickCheck properties+  precisely defining its behaviour. Tests for everything else are encouraged.++For examples of Haddock documentation syntax, have a look at other+extensions.  Important points are:++* Every exported function (or even better, every function) should have+  a Haddock comment explaining what it does, and providing examples.++* Literal chunks of code can be written in comments using+  \"birdtrack\" notation (a greater-than symbol at the beginning of+  each line).  Be sure to leave a blank line before and after each+  birdtrack-quoted section.++* Link to functions by surrounding the names in single quotes, modules+  in double quotes.++* Literal quote marks and slashes should be escaped with a backslash.++To generate and view the Haddock documentation for your extension, run++> runhaskell Setup haddock++and then point your browser to @\/path\/to\/XMonadContrib\/dist\/doc\/html\/xmonad-contrib\/index.html@.++For more information, see the Haddock documentation:+<http://www.haskell.org/haddock/doc/html/index.html>.++For more information on the nuts and bolts of how to develop your own+extension, see the tutorial on the wiki:+<http://haskell.org/haskellwiki/Xmonad/xmonad_development_tutorial>.++-}++{- $license++New modules should identify the author, and be submitted under the+same license as xmonad (BSD3 license or freer).++-}
+ XMonad/Doc/Extending.hs view
@@ -0,0 +1,984 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Doc.Extending+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  portable+--+-- This module documents the xmonad-contrib library and+-- how to use it to extend the capabilities of xmonad.+--+-- Reading this document should not require a deep knowledge of+-- Haskell; the examples are intended to be useful and understandable+-- for those users who do not know Haskell and don't want to have to+-- learn it just to configure xmonad.  You should be able to get by+-- just fine by ignoring anything you don't understand and using the+-- provided examples as templates.  However, relevant Haskell features+-- are discussed when appropriate, so this document will hopefully be+-- useful for more advanced Haskell users as well.+--+-- Those wishing to be totally hardcore and develop their own xmonad+-- extensions (it's easier than it sounds, we promise!) should read+-- the documentation in "XMonad.Doc.Developing".+--+-- More configuration examples may be found on the Haskell wiki:+--+-- <http://haskell.org/haskellwiki/Xmonad/Config_archive>+--+-----------------------------------------------------------------------------++module XMonad.Doc.Extending+    (+    -- * The xmonad-contrib library+    -- $library++    -- ** Actions+    -- $actions++    -- ** Configurations+    -- $configs++    -- ** Hooks+    -- $hooks++    -- ** Layouts+    -- $layouts++    -- ** Prompts+    -- $prompts++    -- ** Utilities+    -- $utils++    -- * Extending xmonad+    -- $extending++    -- ** Editing key bindings+    -- $keys++    -- *** Adding key bindings+    -- $keyAdding++    -- *** Removing key bindings+    -- $keyDel++    -- *** Adding and removing key bindings+    -- $keyAddDel++    -- ** Editing mouse bindings+    -- $mouse++    -- ** Editing the layout hook+    -- $layoutHook++    -- ** Editing the manage hook+    -- $manageHook++    -- ** The log hook and external status bars+    -- $logHook+    ) where++--------------------------------------------------------------------------------+--+--  The XmonadContrib Library+--+--------------------------------------------------------------------------------++{- $library++The xmonad-contrib (xmc) library is a set of extension modules+contributed by xmonad hackers and users, which provide additional+xmonad features.  Examples include various layout modes (tabbed,+spiral, three-column...), prompts, program launchers, the ability to+manipulate windows and workspaces in various ways, alternate+navigation modes, and much more.  There are also \"meta-modules\"+which make it easier to write new modules and extensions.++This is a concise yet complete overview of the xmonad-contrib modules.+For more information about any particular module, just click on its+name to view its Haddock documentation; each module should come with+extensive documentation.  If you find a module that could be better+documented, or has incorrect documentation, please report it as a bug+(<http://code.google.com/p/xmonad/issues/list>)!++-}++{- $actions++In the @XMonad.Actions@ namespace you can find modules exporting+various functions that are usually intended to be bound to key+combinations or mouse actions, in order to provide functionality+beyond the standard keybindings provided by xmonad.++See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to+edit your key bindings.++* "XMonad.Actions.Commands": running internal xmonad actions+  interactively.++* "XMonad.Actions.ConstrainedResize": an aspect-ratio-constrained+  window resizing mode.++* "XMonad.Actions.CopyWindow": duplicating windows on multiple+  workspaces.++* "XMonad.Actions.CycleSelectedLayouts": bind a key to cycle through a+  particular subset of your layouts.++* "XMonad.Actions.CycleWS": move between workspaces in various ways.++* "XMonad.Actions.DeManage": cease management of a window without+  unmapping it.++* "XMonad.Actions.DwmPromote": dwm-like master window swapping.++* "XMonad.Actions.DynamicWorkspaces": add, delete, and rename workspaces.++* "XMonad.Actions.FindEmptyWorkspace": find an empty workspace.++* "XMonad.Actions.FlexibleManipulate": move\/resize windows without+  warping the mouse.++* "XMonad.Actions.FlexibleResize": resize windows from any corner.++* "XMonad.Actions.FloatKeys": move\/resize floating windows with+  keybindings.++* "XMonad.Actions.FocusNth": focus the nth window on the screen.++* "XMonad.Actions.MouseGestures": bind mouse gestures to actions.++* "XMonad.Actions.MouseResize": use with+  "XMonad.Layout.WindowArranger" to resize windows with the mouse when+  using a floating layout.++* "XMonad.Actions.NoBorders": forcibly remove borders from a window.+  Not to be confused with "XMonad.Layout.NoBorders".++* "XMonad.Actions.PerWorkspaceKeys": configure keybindings+  per-workspace.++* "XMonad.Actions.Promote": An action to move the focused window to+  the master pane, or swap the master with the next window.++* "XMonad.Actions.RotSlaves": rotate non-master windows.++* "XMonad.Actions.Search": provide helpful functions for easily+  running web searchs.++* "XMonad.Actions.SimpleDate": display the date in a popup menu.++* "XMonad.Actions.SinkAll": sink all floating windows.++* "XMonad.Actions.Submap": create key submaps, i.e. the ability to+  bind actions to key sequences rather than being limited to single+  key combinations.++* "XMonad.Actions.SwapWorkspaces": swap workspace tags.++* "XMonad.Actions.TagWindows": tag windows and select by tag.++* "XMonad.Actions.UpdatePointer": mouse-follows-focus.++* "XMonad.Actions.Warp": warp the pointer.++* "XMonad.Actions.WindowBringer": bring windows to you, and you to+  windows.++* "XMonad.Actions.WindowGo": travel to windows based on various+  criteria; conditionally start a program if a window does not exist,+  or travel to that window if it does.++-}++{- $configs++In the @XMonad.Config@ namespace you can find modules exporting the+configurations used by some of the xmonad and xmonad-contrib+developers.  You can look at them for examples while creating your own+configuration; you can also simply import them and use them as your+own configuration, possibly with some modifications.++* "XMonad.Config.Arossato"++* "XMonad.Config.Dons"++* "XMonad.Config.Droundy"++* "XMonad.Config.Sjanssen"++-}++{- $hooks++In the @XMonad.Hooks@ namespace you can find modules exporting+hooks. Hooks are actions that xmonad performs when certain events+occur. The two most important hooks are:++* 'XMonad.Core.manageHook': this hook is called when a new window+  xmonad must take care of is created. This is a very powerful hook,+  since it lets us examine the new window's properties and act+  accordingly. For instance, we can configure xmonad to put windows+  belonging to a given application in the float layer, not to manage+  dock applications, or open them in a given workspace. See+  "XMonad.Doc.Extending#Editing_the_manage_hook" for more information on+  customizing 'XMonad.Core.manageHook'.++* 'XMonad.Core.logHook': this hook is called when the stack of windows+  managed by xmonad has been changed, by calling the+  'XMonad.Operations.windows' function. For instance+  "XMonad.Hooks.DynamicLog" will produce a string (whose format can be+  configured) to be printed to the standard output. This can be used+  to display some information about the xmonad state in a status bar.+  See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for more+  information.++Here is a list of the modules found in @XMonad.Hooks@:++* "XMonad.Hooks.DynamicLog": for use with 'XMonad.Core.logHook'; send+  information about xmonad's state to standard output, suitable for+  putting in a status bar of some sort. See+  "XMonad.Doc.Extending#The_log_hook_and_external_status_bars".++* "XMonad.Hooks.EventHook": a hook to handle X events at the layout level.++* "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications.++* "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows (such as+  status bars) appropriately, by de-managing them and creating+  appropriate gaps so as not to place other windows covering them.++* "XMonad.Hooks.ManageHelpers": provide helper functions to be used+  in @manageHook@.++* "XMonad.Hooks.ServerMode": example use of "XMonad.Hooks.EventHook".++* "XMonad.Hooks.SetWMName": set the WM name.  Useful when e.g. running+  Java GUI programs.++* "XMonad.Hooks.UrgencyHook": configure an action to occur when a window+  sets the urgent flag.++* "XMonad.Hooks.XPropManage": match on XProperties in your+  'XMonad.Core.manageHook'.++-}++{- $layouts++In the @XMonad.Layout@ namespace you can find modules exporting+contributed tiling algorithms, such as a tabbed layout, a circle, a spiral,+three columns, and so on.++You will also find modules which provide facilities for combining+different layouts, such as "XMonad.Layout.Combo", or+"XMonad.Layout.LayoutCombinators".++Layouts can be also modified with layout modifiers. A general+interface for writing layout modifiers is implemented in+"XMonad.Layout.LayoutModifier".++For more information on using those modules for customizing your+'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook".++* "XMonad.Layout.Accordion": put non-focused windows in ribbons at the+  top and bottom of the screen.++* "XMonad.Layout.Circle": an elliptical, overlapping layout.++* "XMonad.Layout.Combo": combine multiple layouts into one.++* "XMonad.Layout.Decoration": decorated layouts.++* "XMonad.Layout.DecorationMadness": some examples of decorated layouts.++* "XMonad.Layout.Dishes": stack extra windows underneath the master windows.++* "XMonad.Layout.DragPane": split the screen into two windows with a+  draggable divider.++* "XMonad.Layout.DwmStyle": windows decorated in a dwm-like style.++* "XMonad.Layout.Grid": put windows in a square grid.++* "XMonad.Layout.HintedTile": gapless tiled layout that attempts to+  obey window size hints.++* "XMonad.Layout.IM": a layout for multi-window instant message clients.++* "XMonad.Layout.LayoutCombinators": general layout combining.++* "XMonad.Layout.LayoutHints": make layouts respect window size hints.++* "XMonad.Layout.LayoutModifier": a general framework for creating+  layout \"modifiers\"; useful for creating new layout modules.++* "XMonad.Layout.LayoutScreens": divide the screen into multiple+  virtual \"screens\".++* "XMonad.Layout.MagicFocus": automagically put the focused window in+  the master area.++* "XMonad.Layout.Magnifier": increase the size of the focused window++* "XMonad.Layout.Maximize": temporarily maximize the focused window.++* "XMonad.Layout.MosaicAlt": give each window a specified relative+  amount of screen space.++* "XMonad.Layout.MultiToggle": dynamically apply and unapply layout+  transformers.++* "XMonad.Layout.Named": change the names of layouts (as reported by+  e.g. "XMonad.Hooks.DynamicLog").++* "XMonad.Layout.NoBorders": display windows without borders.++* "XMonad.Layout.PerWorkspace": configure layouts on a per-workspace basis.++* "XMonad.Layout.Reflect": reflect any layout vertically or horizontally.++* "XMonad.Layout.ResizableTile": tiled layout allowing you to change+  width and height of windows.++* "XMonad.Layout.ResizeScreen": a layout modifier to change the screen+  geometry on one side.++* "XMonad.Layout.Roledex": a \"completely pointless layout which acts+  like Microsoft's Flip 3D\".++* "XMonad.Layout.ScratchWorkspace": implements a scratch workspace+  which can be shown and hidden with keybindings.++* "XMonad.Layout.ShowWName": Show the name of the current workspace when switching.++* "XMonad.Layout.SimpleDecoration": add simple decorations to windows.++* "XMonad.Layout.SimpleFloat": a basic floating layout.++* "XMonad.Layout.Simplest": a basic, simple layout that just lays out+  all windows with a fullscreen geometry.  Used by+  "XMonad.Layout.Tabbed".++* "XMonad.Layout.Spiral": Fibonacci spiral layout.++* "XMonad.Layout.Square": split the screen into a square area plus the rest.++* "XMonad.Layout.TabBarDecoration": add a bar of tabs to any layout.++* "XMonad.Layout.Tabbed": a tabbed layout.++* "XMonad.Layout.ThreeColumns": a layout with three columns instead of two.++* "XMonad.Layout.ToggleLayouts": toggle between two layouts.++* "XMonad.Layout.TwoPane": split the screen horizontally and show two+  windows.++* "XMonad.Layout.WindowArranger": make any layout into a+  pseudo-floating layout by allowing you to move and resize windows.++* "XMonad.Layout.WindowNavigation": navigate around a workspace+  directionally instead of using mod-j\/k.++* "XMonad.Layout.WorkspaceDir": set the current working directory in a+  workspace.++-}++{- $prompts++In the @XMonad.Prompt@ name space you can find modules providing+graphical prompts for getting user input and using it to perform+various actions.++The "XMonad.Prompt" provides a library for easily writing new prompt+modules.++These are the available prompts:++* "XMonad.Prompt.AppendFile": append lines of text to a file.++* "XMonad.Prompt.Directory": prompt for a directory.++* "XMonad.Prompt.DirExec": put a bunch of scripts you want in a+  directory, then choose from among them with this prompt.++* "XMonad.Prompt.Email": an example of "XMonad.Prompt.Input", send+  simple short e-mails from a prompt.++* "XMonad.Prompt.Input": useful for building general actions requiring+  input from a prompt.++* "XMonad.Prompt.Layout": choose a layout from a prompt.++* "XMonad.Prompt.Man": open man pages.++* "XMonad.Prompt.RunOrRaise": choose a program, and run it if not+  already running, or raise its window if it is.++* "XMonad.Prompt.Shell": run a shell command.++* "XMonad.Prompt.Ssh": open an ssh connection.++* "XMonad.Prompt.Theme": choose a decoration theme.++* "XMonad.Prompt.Window": choose an open window.++* "XMonad.Prompt.Workspace": choose a workspace.++* "XMonad.Prompt.XMonad": perform various xmonad actions by choosing+  one from a prompt.++Usually a prompt is called by some key binding. See+"XMonad.Doc.Extending#Editing_key_bindings", which includes examples+of adding some prompts.++-}++{- $utils++In the @XMonad.Util@ namespace you can find modules exporting various+utility functions that are used by the other modules of the+xmonad-contrib library.++There are also utilities for helping in configuring xmonad or using+external utilities.++A non complete list with a brief description:++* "XMonad.Util.CustomKeys": configure key bindings (see+  "XMonad.Doc.Extending#Editing_key_bindings").++* "XMonad.Util.Dmenu": a dmenu binding.++* "XMonad.Util.Dzen" "XMonad.Util.Dmenu" provide useful functions for+  running dzen as a xmonad status bar and dmenu as a program launcher;++* "XMonad.Util.EZConfig": configure key bindings easily, including a+  parser for writing key bindings in "M-C-x" style.++* "XMonad.Util.Font": A module for abstracting a font facility over+  Core fonts and Xft++* "XMonad.Util.Invisible": a wrapper data type to store layout state+  which should not be persisted across restarts.++* "XMonad.Util.Loggers": a collection of loggers that can be used in+  conjunction with "XMonad.Hooks.DynamicLog".++* "XMonad.Util.NamedWindows": associate windows with their X titles.+  Used by, e.g. "XMonad.Layout.Tabbed".++* "XMonad.Util.Run": a collection of functions for running external+  processes.++* "XMonad.Util.Scratchpad": hotkey-launched floating terminal window.++* "XMonad.Util.Themes": a collection of themes to be used with+  floating layouts.++* "XMonad.Util.Timer": set up a timer to handle deferred events.++* "XMonad.Util.WindowProperties": an EDSL for specifying and matching+  on window properties.++* "XMonad.Util.WorkspaceCompare": general combinators for sorting+  workspaces in various ways, used by several other modules which need+  to sort workspaces (e.g. "XMonad.Hooks.DynamicLog").++* "XMonad.Util.Paste" provides utilities for pasting or sending keys and+  strings to windows;++* "XMonad.Util.XSelection" provide utilities for using the mouse+  selection;++* "XMonad.Util.XUtils" and "XMonad.Util.Font" are libraries for+  accessing Xlib and XFT function in a convenient way.++-}++--------------------------------------------------------------------------------+--+--  Extending Xmonad+--+--------------------------------------------------------------------------------++{- $extending+#Extending_xmonad#++Since the @xmonad.hs@ file is just another Haskell module, you may+import and use any Haskell code or libraries you wish, such as+extensions from the xmonad-contrib library, or other code you write+yourself.++-}++{- $keys+#Editing_key_bindings#++Editing key bindings means changing the 'XMonad.Core.XConfig.keys'+field of the 'XMonad.Core.XConfig' record used by xmonad.  For+example, you could write:++>    import XMonad+>+>    main = xmonad $ defaultConfig { keys = myKeys }++and provide an appropriate definition of @myKeys@, such as:++>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]++This particular definition also requires importing "XMonad.Prompt",+"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":++> import XMonadPrompt+> import ...  -- and so on++For a list of the names of particular keys (such as xK_F12, and so+on), see+<http://hackage.haskell.org/packages/archive/X11/1.4.1/doc/html/Graphics-X11-Types.html>.++Usually, rather than completely redefining the key bindings, as we did+above, we want to simply add some new bindings and\/or remove existing+ones.++-}++{- $keyAdding+#Adding_key_bindings#++Adding key bindings can be done in different ways. The type signature+of 'XMonad.Core.XConfig.keys' is:++>    keys :: XConfig Layout -> M.Map (ButtonMask,KeySym) (X ())++In order to add new key bindings, you need to first create an+appropriate 'Data.Map.Map' from a list of key bindings using+'Data.Map.fromList'.  This 'Data.Map.Map' of new key bindings then+needs to be joined to a 'Data.Map.Map' of existing bindings using+'Data.Map.union'.++Since we are going to need some of the functions of the "Data.Map"+module, before starting we must first import this modules:++>    import qualified Data.Map as M+++For instance, if you have defined some additional key bindings like+these:++>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]++then you can create a new key bindings map by joining the default one+with yours:++>    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))++Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field+of the configuration:++>    main = xmonad $ defaultConfig { keys = newKeys }++All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:+++>    module Main (main) where+>+>    import XMonad+>+>    import qualified Data.Map as M+>    import Graphics.X11.Xlib+>    import XMonad.Prompt+>    import XMonad.Prompt.Shell+>    import XMonad.Prompt.XMonad+>+>    main :: IO ()+>    main = xmonad $ defaultConfig { keys = newKeys }+>+>    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))+>+>    myKeys x =+>             [ ((modMask x, xK_F12), xmonadPrompt defaultXPConfig)+>             , ((modMask x, xK_F3 ), shellPrompt  defaultXPConfig)+>             ]++There are much simpler ways to accomplish this, however, if you are+willing to use an extension module to help you configure your keys.+For instance, "XMonad.Util.EZConfig" and "XMonad.Util.CustomKeys" both+provide useful functions for editing your key bindings; "XMonad.Util.EZConfig" even lets you use emacs-style keybinding descriptions like \"M-C-<F12>\".++ -}++{- $keyDel+#Removing_key_bindings#++Removing key bindings requires modifying the 'Data.Map.Map' which+stores the key bindings.  This can be done with 'Data.Map.difference'+or with 'Data.Map.delete'.++For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@+(you just want to leave xmonad running forever). To do this you need+to define @newKeys@ as a 'Data.Map.difference' between the default+map and the map of the key bindings you want to remove.  Like so:++>    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)+>+>    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]+>    keysToRemove x =+>             [ ((modMask x              , xK_q ), return ())+>             , ((modMask x .|. shiftMask, xK_q ), return ())+>             ]++As you can see, it doesn't matter what actions we associate with the+keys listed in @keysToRemove@, so we just use @return ()@ (the+\"null\" action).++It is also possible to simply define a list of keys we want to unbind+and then use 'Data.Map.delete' to remove them. In that case we would+write something like:++>    newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)+>+>    keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]+>    keysToRemove x =+>             [ (modMask x              , xK_q )+>             , (modMask x .|. shiftMask, xK_q )+>             ]++Another even simpler possibility is the use of some of the utilities+provided by the xmonad-contrib library. Look, for instance, at+'XMonad.Util.EZConfig.removeKeys'.++-}++{- $keyAddDel+#Adding_and_removing_key_bindings#++Adding and removing key bindings requires simply combining the steps+for removing and adding.  Here is an example from+"XMonad.Config.Arossato":++>    defKeys    = keys defaultConfig+>    delKeys x  = foldr M.delete           (defKeys x) (toRemove x)+>    newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)+>    -- remove some of the default key bindings+>    toRemove x =+>        [ (modMask x              , xK_j     )+>        , (modMask x              , xK_k     )+>        , (modMask x              , xK_p     )+>        , (modMask x .|. shiftMask, xK_p     )+>        , (modMask x .|. shiftMask, xK_q     )+>        , (modMask x              , xK_q     )+>        ] +++>        -- I want modMask .|. shiftMask 1-9 to be free!+>        [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]+>    -- These are my personal key bindings+>    toAdd x   =+>        [ ((modMask x              , xK_F12   ), xmonadPrompt defaultXPConfig )+>        , ((modMask x              , xK_F3    ), shellPrompt  defaultXPConfig )+>        ] +++>        -- Use modMask .|. shiftMask .|. controlMask 1-9 instead+>        [( (m .|. modMask x, k), windows $ f i)+>         | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]+>        ,  (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]+>        ]++You can achieve the same result using the "XMonad.Util.CustomKeys"+module; take a look at the 'XMonad.Util.CustomKeys.customKeys'+function in particular.++-}++{- $mouse+#Editing_mouse_bindings#++Most of the previous discussion of key bindings applies to mouse+bindings as well.  For example, you could configure button4 to close+the window you click on like so:++>    import qualified Data.Map as M+>+>    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]+>+>    newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))+>+>    main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }++Overriding or deleting mouse bindings works similarly.  You can also+configure mouse bindings much more easily using the+'XMonad.Util.EZConfig.additionalMouseBindings' and+'XMonad.Util.EZConfig.removeMouseBindings' functions from the+"XMonad.Util.EZConfig" module.++-}++{- $layoutHook+#Editing_the_layout_hook#++When you start an application that opens a new window, when you change+the focused window, or move it to another workspace, or change that+workspace's layout, xmonad will use the 'XMonad.Core.layoutHook' for+reordering the visible windows on the visible workspace(s).++Since different layouts may be attached to different workspaces, and+you can change them, xmonad needs to know which one to use. In this+sense the layoutHook may be thought as the list of layouts that+xmonad will use for laying out windows on the screen(s).++The problem is that the layout subsystem is implemented with an+advanced feature of the Haskell programming language: type classes.+This allows us to very easily write new layouts, combine or modify+existing layouts, create layouts with internal state, etc. See+"XMonad.Doc.Extending#The_LayoutClass" for more information. This+means that we cannot simply have a list of layouts as we used to have+before the 0.5 release: a list requires every member to belong to the+same type!++Instead the combination of layouts to be used by xmonad is created+with a specific layout combinator: 'XMonad.Layout.|||'.++Suppose we want a list with the 'XMonad.Layout.Full',+'XMonad.Layout.Tabbed.tabbed' and+'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our+@~\/.xmonad\/xmonad.hs@, all the needed modules:++>    import XMonad+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion++Then we create the combination of layouts we need:++>    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion+++Now, all we need to do is change the 'XMonad.Core.layoutHook'+field of the 'XMonad.Core.XConfig' record, like so:++>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }++Thanks to the new combinator, we can apply a layout modifier to a+whole combination of layouts, instead of applying it to each one. For+example, suppose we want to use the+'XMonad.Layout.NoBorders.noBorders' layout modifier, from the+"XMonad.Layout.NoBorders" module (which must be imported):++>    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)++If we want only the tabbed layout without borders, then we may write:++>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion++Our @~\/.xmonad\/xmonad.hs@ will now look like this:++>    import XMonad+>+>    import XMonad.Layout.Tabbed+>    import XMonad.Layout.Accordion+>    import XMonad.Layout.NoBorders+>+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion+>+>    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }++That's it!++-}++{- $manageHook+#Editing_the_manage_hook#++The 'XMonad.Core.manageHook' is a very powerful tool for customizing+the behavior of xmonad with regard to new windows.  Whenever a new+window is created, xmonad calls the 'XMonad.Core.manageHook', which+can thus be used to perform certain actions on the new window, such as+placing it in a specific workspace, ignoring it, or placing it in the+float layer.++The default 'XMonad.Core.manageHook' causes xmonad to float MPlayer+and Gimp, and to ignore gnome-panel, desktop_window, kicker, and+kdesktop.++The "XMonad.ManageHook" module provides some simple combinators that+can be used to alter the 'XMonad.Core.manageHook' by replacing or adding+to the default actions.++Let's start by analyzing the default 'XMonad.Config.manageHook', defined+in "XMonad.Config":+++>    manageHook :: ManageHook+>    manageHook = composeAll+>                    [ className =? "MPlayer"        --> doFloat+>                    , className =? "Gimp"           --> doFloat+>                    , resource  =? "desktop_window" --> doIgnore+>                    , resource  =? "kdesktop"       --> doIgnore ]++'XMonad.ManageHook.composeAll' can be used to compose a list of+different 'XMonad.Config.ManageHook's. In this example we have a list+of 'XMonad.Config.ManageHook's formed by the following commands: the+Mplayer's and the Gimp's windows, whose 'XMonad.ManageHook.className'+are, respectively \"Mplayer\" and \"Gimp\", are to be placed in the+float layer with the 'XMonad.ManageHook.doFloat' function; the windows+whose resource names are respectively \"desktop_window\" and+\kdesktop\" are to be ignored with the 'XMonad.ManageHook.doIgnore'+function.++This is another example of 'XMonad.Config.manageHook', taken from+"XMonad.Config.Arossato":++>    myManageHook  = composeAll [ resource =? "realplay.bin" --> doFloat+>                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf+>                               , resource =? "firefox-bin"  --> doF (W.shift "web")+>                               ]+>    newManageHook = myManageHook <+> manageHook defaultConfig+++Again we use 'XMonad.ManageHook.composeAll' to compose a list of+different 'XMonad.Config.ManageHook's. The first one will put+RealPlayer on the float layer, the second one will put the xpdf+windows in the workspace named \"doc\", with 'XMonad.ManageHook.doF'+and 'XMonad.StackSet.shift' functions, and the third one will put all+firefox windows on the workspace called "web". Then we use the+'XMonad.ManageHook.<+>' combinator to compose @myManageHook@ with the+default 'XMonad.Config.manageHook' to form @newManageHook@.++Each 'XMonad.Config.ManageHook' has the form:++>    property =? match --> action++Where @property@ can be:++* 'XMonad.ManageHook.title': the window's title++* 'XMonad.ManageHook.resource': the resource name++* 'XMonad.ManageHook.className': the resource class name.++* 'XMonad.ManageHook.stringProperty' @somestring@: the contents of the+  property @somestring@.++(You can retrieve the needed information using the X utility named+@xprop@; for example, to find the resource class name, you can type++> xprop | grep WM_CLASS++at a prompt, then click on the window whose resource class you want to+know.)++@match@ is the string that will match the property value (for instance+the one you retrieved with @xprop@).++An  @action@ can be:++* 'XMonad.ManageHook.doFloat': to place the window in the float layer;++* 'XMonad.ManageHook.doIgnore': to ignore the window;++* 'XMonad.ManageHook.doF': to execute a function with the window as+  argument.++For example, suppose we want to add a 'XMonad.Config.manageHook' to+float RealPlayer, which usually has a 'XMonad.ManageHook.resource'+name of \"realplay.bin\".++First we need to import "XMonad.ManageHook":++>    import XMonad.ManageHook++Then we create our own 'XMonad.Config.manageHook':++>    myManageHook = resource =? "realplay.bin" --> doFloat++We can now use the 'XMonad.ManageHook.<+>' combinator to add our+'XMonad.Config.manageHook' to the default one:++>    newManageHook = myManageHook <+> manageHook defaultConfig++(Of course, if we wanted to completely replace the default+'XMonad.Config.manageHook', this step would not be necessary.) Now,+all we need to do is change the 'XMonad.Core.manageHook' field of the+'XMonad.Core.XConfig' record, like so:++>    main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }++And we are done.++Obviously, we may wish to add more then one+'XMonad.Config.manageHook'. In this case we can use a list of hooks,+compose them all with 'XMonad.ManageHook.composeAll', and add the+composed to the default one.++For instance, if we want RealPlayer to float and thunderbird always+opened in the workspace named "mail", we can do so like this:++>    myManageHook = composeAll [ resource =? "realplay.bin"    --> doFloat+>                              , resource =? "thunderbird-bin" --> doF (W.shift "mail")+>                              ]++Remember to import the module that defines the 'XMonad.StackSet.shift'+function, "XMonad.StackSet", like this:++>    import qualified XMonad.StackSet as W++And then we can add @myManageHook@ to the default one to create+@newManageHook@ as we did in the previous example.++One more thing to note about this system is that if+a window matches multiple rules in a 'XMonad.Config.manageHook', /all/+of the corresponding actions will be run (in the order in which they+are defined).  This is a change from versions before 0.5, when only+the first rule that matched was run.++Finally, for additional rules and actions you can use in your+manageHook, check out the contrib module "XMonad.Hooks.ManageHelpers".++-}++{- $logHook+#The_log_hook_and_external_status_bars#++When the stack of the windows managed by xmonad changes for any+reason, xmonad will call 'XMonad.Core.logHook', which can be used to+output some information about the internal state of xmonad, such as the+layout that is presently in use, the workspace we are in, the focused+window's title, and so on.++Extracting information about the internal xmonad state can be somewhat+difficult if you are not familiar with the source code. Therefore,+it's usually easiest to use a module that has been designed+specifically for logging some of the most interesting information+about the internal state of xmonad: "XMonad.Hooks.DynamicLog".  This+module can be used with an external status bar to print the produced+logs in a convenient way; the most commonly used status bars are dzen+and xmobar.++By default the 'XMonad.Core.logHook' doesn't produce anything. To+enable it you need first to import "XMonad.Hooks.DynamicLog":++>    import XMonad.Hooks.DynamicLog++Then you just need to update the 'XMonad.Core.logHook' field of the+'XMonad.Core.XConfig' record with one of the provided functions. For+example:++>    main = xmonad defaultConfig { logHook = dynamicLog }++More interesting configurations are also possible; see the+"XMonad.Hooks.DynamicLog" module for more possibilities.++You may now enjoy your extended xmonad experience.++Have fun!++-}
+ XMonad/Hooks/BluetileDock.hs view
@@ -0,0 +1,43 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.BluetileDock+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Hooks.BluetileDock (+    bluetileDock+  ) where++import XMonad+import qualified XMonad.StackSet as S+import System.IO+import Control.Monad(forM_)++data DockOutput = DO Int String String deriving (Show, Read)++bluetileDock :: Handle -> X ()+bluetileDock outputHandle = do+    ws <- gets windowset+    let allscreens = S.screens ws+    let outputs = for allscreens $ \s -> DO (getScreenId (S.screen s))+                                            (getLayoutDesc s)+                                            (getCurrentWorkspace s)+    forM_ outputs $ \o -> io $ hPutStrLn outputHandle $ show o++getScreenId :: ScreenId -> Int+getScreenId (S sid) = sid++getLayoutDesc :: S.Screen i (Layout Window) a sid sd -> String+getLayoutDesc = description . S.layout . S.workspace++getCurrentWorkspace :: S.Screen i l a sid sd -> i+getCurrentWorkspace = S.tag . S.workspace++for :: [a] -> (a -> b) -> [b]+for = flip map
+ XMonad/Hooks/CustomRestart.hs view
@@ -0,0 +1,32 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.CustomRestart+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Hooks.CustomRestart+    ( CustomRestart (..)+    , customRestartEventHook+    ) where++import Control.Monad (when)+import Data.Monoid++import XMonad++data CustomRestart = CustomRestart deriving ( Show, Read )++customRestartEventHook :: String -> Event -> X All+customRestartEventHook prog (ClientMessageEvent {ev_message_type = mt}) = do+        d <- asks display+        a <- io $ internAtom d "XMONAD_CUSTOM_RESTART" False+        when (mt == a) $ do+            restart prog True+        return (All True)+customRestartEventHook _ _ = return (All True)
+ XMonad/Hooks/DynamicHooks.hs view
@@ -0,0 +1,122 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DynamicHooks+-- Copyright   :  (c) Braden Shepherdson 2008+-- License     :  BSD-style (as xmonad)+--+-- Maintainer  :  Braden.Shepherdson@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- One-shot and permanent ManageHooks that can be updated at runtime.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DynamicHooks (+  -- * Usage+  -- $usage+  initDynamicHooks+  ,dynamicMasterHook+  ,addDynamicHook+  ,updateDynamicHook+  ,oneShotHook+  ) where++import XMonad+import System.IO++import Data.List+import Data.Maybe (listToMaybe)+import Data.Monoid+import Data.IORef++-- $usage+-- Provides two new kinds of 'ManageHooks' that can be defined at runtime.+--+-- * One-shot 'ManageHooks' that are deleted after they execute.+--+-- * Permanent 'ManageHooks' (unless you want to destroy them)+--+-- Note that you will lose all dynamically defined 'ManageHook's when you @mod+q@!+-- If you want them to last, you should create them as normal in your @xmonad.hs@.+--+-- First, you must execute 'initDynamicHooks' from 'main' in your @xmonad.hs@:+--+-- > dynHooksRef <- initDynamicHooks+--+-- and then pass this value to the other functions in this module.+--+-- You also need to add the base 'ManageHook':+--+-- > xmonad { manageHook = myManageHook <+> dynamicMasterHook dynHooksRef }+--+-- You must include this @dynHooksRef@ value when using the functions in this+-- module:+--+-- > xmonad { keys = myKeys `Data.Map.union` Data.Map.fromList +-- >                   [((modMask conf, xK_i), oneShotHook dynHooksRef +-- >                    "FFlaunchHook" (className =? "firefox") (doShift "3") +-- >                    >> spawn "firefox")+-- >                   ,((modMask conf, xK_u), addDynamicHook dynHooksRef +-- >                     (className =? "example" --> doFloat))+-- >                   ,((modMask conf, xK_y), updatePermanentHook dynHooksRef+-- >                     (const idHook))) ]  -- resets the permanent hook.+--++data DynamicHooks = DynamicHooks+    { transients :: [(Query Bool, ManageHook)]+    , permanent  :: ManageHook }+      ++-- | Creates the 'IORef' that stores the dynamically created 'ManageHook's.+initDynamicHooks :: IO (IORef DynamicHooks)+initDynamicHooks = newIORef (DynamicHooks { transients = [],+                                            permanent = idHook })+++-- this hook is always executed, and the IORef's contents checked.+-- note that transient hooks are run second, therefore taking precedence+-- over permanent ones on matters such as which workspace to shift to.+-- doFloat and doIgnore are idempotent.+-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.+dynamicMasterHook :: IORef DynamicHooks -> ManageHook+dynamicMasterHook ref = return True --> +                  (ask >>= \w -> liftX (do+  dh <- io $ readIORef ref+  (Endo f)  <- runQuery (permanent dh) w+  ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)+  let (ts',nts) = partition fst ts+  gs <- mapM (flip runQuery w . snd . snd) ts'+  let (Endo g) = maybe (Endo id) id $ listToMaybe gs+  io $ writeIORef ref $ dh { transients = map snd nts }+  return $ Endo $ f . g+                                       ))++-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.+addDynamicHook :: IORef DynamicHooks -> ManageHook -> X ()+addDynamicHook ref m = updateDynamicHook ref (<+> m)+++-- | Modifies the permanent 'ManageHook' with an arbitrary function.+updateDynamicHook :: IORef DynamicHooks -> (ManageHook -> ManageHook) -> X ()+updateDynamicHook ref f = +    io $ modifyIORef ref $ \dh -> dh { permanent = f (permanent dh) }+++-- | Creates a one-shot 'ManageHook'. Note that you have to specify the two+-- parts of the 'ManageHook' separately. Where you would usually write:+--+-- > className =? "example" --> doFloat+--+-- you must call 'oneShotHook' as +--+-- > oneShotHook dynHooksRef (className =? "example) doFloat+-- +oneShotHook :: IORef DynamicHooks -> Query Bool -> ManageHook -> X ()+oneShotHook ref q a =+  io $ modifyIORef ref+         $ \dh -> dh { transients = (q,a):(transients dh) }++++
+ XMonad/Hooks/DynamicLog.hs view
@@ -0,0 +1,503 @@+{-# LANGUAGE FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DynamicLog+-- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>+-- Stability   :  unstable+-- Portability :  unportable+--+-- xmonad calls the logHook with every internal state update, which is+-- useful for (among other things) outputting status information to an+-- external status bar program such as xmobar or dzen.  DynamicLog+-- provides several drop-in logHooks for this purpose, as well as+-- flexible tools for specifying your own formatting.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DynamicLog (+    -- * Usage+    -- $usage++    -- * Drop-in loggers+    dzen,+    xmobar,+    statusBar,+    dynamicLog,+    dynamicLogXinerama,++    -- * Build your own formatter+    dynamicLogWithPP,+    dynamicLogString,+    PP(..), defaultPP,++    -- * Example formatters+    dzenPP, xmobarPP, sjanssenPP, byorgeyPP,++    -- * Formatting utilities+    wrap, pad, trim, shorten,+    xmobarColor, xmobarStrip,+    dzenColor, dzenEscape, dzenStrip,++    -- * Internal formatting functions+    pprWindowSet,+    pprWindowSetXinerama++    -- * To Do+    -- $todo++  ) where++--+-- Useful imports+--+import XMonad+import Control.Monad+import Data.Char ( isSpace )+import Data.Maybe ( isJust, catMaybes )+import Data.List+import qualified Data.Map as M+import Data.Ord ( comparing )+import qualified XMonad.StackSet as S+import System.IO+import XMonad.Util.WorkspaceCompare+import XMonad.Util.NamedWindows+import XMonad.Util.Run++import XMonad.Layout.LayoutModifier+import XMonad.Util.Font+import XMonad.Hooks.UrgencyHook+import XMonad.Hooks.ManageDocks++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- >    import XMonad+-- >    import XMonad.Hooks.DynamicLog+--+-- If you just want a quick-and-dirty status bar with zero effort, try+-- the 'xmobar' or 'dzen' functions:+--+-- > main = xmonad =<< xmobar conf+--+-- There is also 'statusBar' if you'd like to use another status bar, or would+-- like to use different formatting options.  The 'xmobar', 'dzen', and+-- 'statusBar' functions are preferred over the other options listed below, as+-- they take care of all the necessary plumbing -- no shell scripting required!+--+-- Alternatively, you can choose among several default status bar formats+-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the+-- appropriate function, for instance:+--+-- > main = xmonad $ defaultConfig {+-- >    ...+-- >    logHook = dynamicLog+-- >    ...+-- >  }+--+-- For more flexibility, you can also use 'dynamicLogWithPP' and supply+-- your own pretty-printing format (by either defining one from scratch,+-- or customizing one of the provided examples).+-- For example:+--+-- >    -- use sjanssen's pretty-printer format, but with the sections+-- >    -- in reverse+-- >    logHook = dynamicLogWithPP $ sjanssenPP { ppOrder = reverse }+--+-- Note that setting the @logHook@ only sets up xmonad's output; you+-- are responsible for starting your own status bar program (e.g. dzen+-- or xmobar) and making sure xmonad's output is piped into it+-- appropriately, either by putting it in your @.xsession@ or similar+-- file, or by using @spawnPipe@ in your @main@ function, for example:+--+-- > import XMonad.Util.Run   -- for spawnPipe and hPutStrLn+-- >+-- > main = do+-- >     h <- spawnPipe "xmobar -options -foo -bar"+-- >     xmonad $ defaultConfig {+-- >       ...+-- >       logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h }+--+-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of+-- your pretty-printer as in the example above; by default the status+-- will be printed to stdout rather than the pipe you create.+--+-- Even if you don't use a statusbar, you can still use+-- 'dynamicLogString' to show on-screen notifications in response to+-- some events. For example, to show the current layout when it+-- changes, you could make a keybinding to cycle the layout and+-- display the current status:+--+-- >    , ((mod1Mask, xK_a     ), sendMessage NextLayout >> (dynamicLogString myPP >>= \d->spawn $"xmessage "++d))+--++-- $todo+--+--   * incorporate dynamicLogXinerama into the PP framework somehow+--+--   * add an xmobarEscape function++------------------------------------------------------------------------++-- | Run xmonad with a dzen status bar set to some nice defaults.+--+-- > main = xmonad =<< dzen conf+--+-- The intent is that the above config file should provide a nice+-- status bar with minimal effort.+--+-- If you wish to customize the status bar format at all, you'll have to+-- use the 'statusBar' function instead.+--+-- The binding uses the XMonad.Hooks.ManageDocks module to automatically+-- handle screen placement for dzen, and enables 'mod-b' for toggling+-- the menu bar.+--+dzen :: LayoutClass l Window+     => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))+dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf+ where+    fg      = "'#a8a3f7'" -- n.b quoting+    bg      = "'#3f3c6d'"+    flags   = "-e 'onstart=lower' -w 400 -ta l -fg " ++ fg ++ " -bg " ++ bg+++-- | Run xmonad with a xmobar status bar set to some nice defaults.+--+-- > main = xmonad =<< xmobar conf+--+-- This works pretty much the same as 'dzen' function above.+--+xmobar :: LayoutClass l Window+       => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))+xmobar conf = statusBar "xmobar" xmobarPP toggleStrutsKey conf++-- | Modifies the given base configuration to launch the given status bar,+-- send status information to that bar, and allocate space on the screen edges+-- for the bar.+statusBar :: LayoutClass l Window+          => String    -- ^ the command line to launch the status bar+          -> PP        -- ^ the pretty printing options+          -> (XConfig Layout -> (KeyMask, KeySym))+                       -- ^ the desired key binding to toggle bar visibility+          -> XConfig l -- ^ the base config+          -> IO (XConfig (ModifiedLayout AvoidStruts l))+statusBar cmd pp k conf = do+    h <- spawnPipe cmd+    return $ conf+        { layoutHook = avoidStruts (layoutHook conf)+        , logHook = do+                        logHook conf+                        dynamicLogWithPP pp { ppOutput = hPutStrLn h }+        , manageHook = manageHook conf <+> manageDocks+        , keys       = liftM2 M.union keys' (keys conf)+        }+ where+    keys' = (`M.singleton` sendMessage ToggleStruts) . k++-- |+-- Helper function which provides ToggleStruts keybinding+--+toggleStrutsKey :: XConfig t -> (KeyMask, KeySym)+toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b )++------------------------------------------------------------------------++-- | An example log hook, which prints status information to stdout in+-- the default format:+--+-- > 1 2 [3] 4 7 : full : title+--+-- That is, the currently populated workspaces, the current+-- workspace layout, and the title of the focused window.+--+-- To customize the output format, see 'dynamicLogWithPP'.+--+dynamicLog :: X ()+dynamicLog = dynamicLogWithPP defaultPP++-- | Format the current status using the supplied pretty-printing format,+--   and write it to stdout.+dynamicLogWithPP :: PP -> X ()+dynamicLogWithPP pp = dynamicLogString pp >>= io . ppOutput pp++-- | The same as 'dynamicLogWithPP', except it simply returns the status+--   as a formatted string without actually printing it to stdout, to+--   allow for further processing, or use in some application other than+--   a status bar.+dynamicLogString :: PP -> X String+dynamicLogString pp = do++    winset <- gets windowset+    urgents <- readUrgents+    sort' <- ppSort pp++    -- layout description+    let ld = description . S.layout . S.workspace . S.current $ winset++    -- workspace list+    let ws = pprWindowSet sort' urgents pp winset++    -- window title+    wt <- maybe (return "") (fmap show . getName) . S.peek $ winset++    -- run extra loggers, ignoring any that generate errors.+    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp++    return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $+                        [ ws+                        , ppLayout pp ld+                        , ppTitle  pp wt+                        ]+                        ++ catMaybes extras++-- | Format the workspace information, given a workspace sorting function,+--   a list of urgent windows, a pretty-printer format, and the current+--   WindowSet.+pprWindowSet :: WorkspaceSort -> [Window] -> PP -> WindowSet -> String+pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $+            map S.workspace (S.current s : S.visible s) ++ S.hidden s+   where this     = S.currentTag s+         visibles = map (S.tag . S.workspace) (S.visible s)++         fmt w = printer pp (S.tag w)+          where printer | S.tag w == this                                               = ppCurrent+                        | S.tag w `elem` visibles                                       = ppVisible+                        | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = \ppC -> ppUrgent ppC . ppHidden ppC+                        | isJust (S.stack w)                                            = ppHidden+                        | otherwise                                                     = ppHiddenNoWindows++-- |+-- Workspace logger with a format designed for Xinerama:+--+-- > [1 9 3] 2 7+--+-- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,+-- and 2 and 7 are non-visible, non-empty workspaces.+--+-- Unfortunately, at the present time, the current layout and window title+-- are not shown, and there is no way to incorporate the xinerama+-- workspace format shown above with 'dynamicLogWithPP'.  Hopefully this+-- will change soon.+dynamicLogXinerama :: X ()+dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama++pprWindowSetXinerama :: WindowSet -> String+pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen+  where onscreen  = map (S.tag . S.workspace)+                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws+        offscreen = map S.tag . filter (isJust . S.stack)+                        . sortBy (comparing S.tag) $ S.hidden ws++-- | Wrap a string in delimiters, unless it is empty.+wrap :: String  -- ^ left delimiter+     -> String  -- ^ right delimiter+     -> String  -- ^ output string+     -> String+wrap _ _ "" = ""+wrap l r m  = l ++ m ++ r++-- | Pad a string with a leading and trailing space.+pad :: String -> String+pad = wrap " " " "++-- | Trim leading and trailing whitespace from a string.+trim :: String -> String+trim = f . f+    where f = reverse . dropWhile isSpace++-- | Limit a string to a certain length, adding "..." if truncated.+shorten :: Int -> String -> String+shorten n xs | length xs < n = xs+             | otherwise     = (take (n - length end) xs) ++ end+ where+    end = "..."++-- | Output a list of strings, ignoring empty ones and separating the+--   rest with the given separator.+sepBy :: String   -- ^ separator+      -> [String] -- ^ fields to output+      -> String+sepBy sep = concat . intersperse sep . filter (not . null)++-- | Use dzen escape codes to output a string with given foreground+--   and background colors.+dzenColor :: String  -- ^ foreground color: a color name, or #rrggbb format+          -> String  -- ^ background color+          -> String  -- ^ output string+          -> String+dzenColor fg bg = wrap (fg1++bg1) (fg2++bg2)+ where (fg1,fg2) | null fg = ("","")+                 | otherwise = ("^fg(" ++ fg ++ ")","^fg()")+       (bg1,bg2) | null bg = ("","")+                 | otherwise = ("^bg(" ++ bg ++ ")","^bg()")++-- | Escape any dzen metacharacters.+dzenEscape :: String -> String+dzenEscape = concatMap (\x -> if x == '^' then "^^" else [x])++-- | Strip dzen formatting or commands. Useful to remove ppHidden+--   formatting in ppUrgent field. For example:+--+-- >     , ppHidden          = dzenColor "gray20" "" . wrap "(" ")"+-- >     , ppUrgent          = dzenColor "dark orange" "" .  dzenStrip+dzenStrip :: String -> String+dzenStrip = strip [] where+    strip keep x+      | null x              = keep+      | "^^" `isPrefixOf` x = strip (keep ++ "^") (drop 2 x)+      | '^' == head x       = strip keep (drop 1 . dropWhile (/= ')') $ x)+      | otherwise           = let (good,x') = span (/= '^') x+                              in strip (keep ++ good) x'++-- | Use xmobar escape codes to output a string with given foreground+--   and background colors.+xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format+            -> String  -- ^ background color+            -> String  -- ^ output string+            -> String+xmobarColor fg bg = wrap t "</fc>"+ where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]++-- ??? add an xmobarEscape function?++-- | Strip xmobar markup. Useful to remove ppHidden color from ppUrgent+--   field. For example:+--+-- >     , ppHidden          = xmobarColor "gray20" "" . wrap "<" ">"+-- >     , ppUrgent          = xmobarColor "dark orange" "" .  xmobarStrip+xmobarStrip :: String -> String+xmobarStrip = strip [] where+    strip keep x+      | null x                 = keep+      | "<fc="  `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= '>') $ x)+      | "</fc>" `isPrefixOf` x = strip keep (drop 5  x)+      | '<' == head x          = strip (keep ++ "<") (tail x)+      | otherwise              = let (good,x') = span (/= '<') x+                                 in strip (keep ++ good) x'++-- | The 'PP' type allows the user to customize the formatting of+--   status information.+data PP = PP { ppCurrent :: WorkspaceId -> String+               -- ^ how to print the tag of the currently focused+               -- workspace+             , ppVisible :: WorkspaceId -> String+               -- ^ how to print tags of visible but not focused+               -- workspaces (xinerama only)+             , ppHidden  :: WorkspaceId -> String+               -- ^ how to print tags of hidden workspaces which+               -- contain windows+             , ppHiddenNoWindows :: WorkspaceId -> String+               -- ^ how to print tags of empty hidden workspaces+             , ppUrgent :: WorkspaceId -> String+               -- ^ format to be applied to tags of urgent workspaces.+               -- NOTE that 'ppUrgent' is applied /in addition to/+               -- 'ppHidden'!+             , ppSep :: String+               -- ^ separator to use between different log sections+               -- (window name, layout, workspaces)+             , ppWsSep :: String+               -- ^ separator to use between workspace tags+             , ppTitle :: String -> String+               -- ^ window title format+             , ppLayout :: String -> String+               -- ^ layout name format+             , ppOrder :: [String] -> [String]+               -- ^ how to order the different log sections. By+               --   default, this function receives a list with three+               --   formatted strings, representing the workspaces,+               --   the layout, and the current window title,+               --   respectively. If you have specified any extra+               --   loggers in 'ppExtras', their output will also be+               --   appended to the list.  To get them in the reverse+               --   order, you can just use @ppOrder = reverse@.  If+               --   you don't want to display the current layout, you+               --   could use something like @ppOrder = \\(ws:_:t:_) ->+               --   [ws,t]@, and so on.+             , ppSort :: X ([WindowSpace] -> [WindowSpace])+               -- ^ how to sort the workspaces.  See+               -- "XMonad.Util.WorkspaceCompare" for some useful+               -- sorts.+             , ppExtras :: [X (Maybe String)]+               -- ^ loggers for generating extra information such as+               -- time and date, system load, battery status, and so+               -- on.  See "XMonad.Util.Loggers" for examples, or create+               -- your own!+             , ppOutput :: String -> IO ()+               -- ^ applied to the entire formatted string in order to+               -- output it.  Can be used to specify an alternative+               -- output method (e.g. write to a pipe instead of+               -- stdout), and\/or to perform some last-minute+               -- formatting.+             }++-- | The default pretty printing options, as seen in 'dynamicLog'.+defaultPP :: PP+defaultPP = PP { ppCurrent         = wrap "[" "]"+               , ppVisible         = wrap "<" ">"+               , ppHidden          = id+               , ppHiddenNoWindows = const ""+               , ppUrgent          = id+               , ppSep             = " : "+               , ppWsSep           = " "+               , ppTitle           = shorten 80+               , ppLayout          = id+               , ppOrder           = id+               , ppOutput          = putStrLn+               , ppSort            = getSortByIndex+               , ppExtras          = []+               }++-- | Settings to emulate dwm's statusbar, dzen only. Uses dzenStrip in+-- ppUrgent.+dzenPP :: PP+dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad+                     , ppVisible  = dzenColor "black" "#999999" . pad+                     , ppHidden   = dzenColor "black" "#cccccc" . pad+                     , ppHiddenNoWindows = const ""+                     , ppUrgent   = dzenColor "red" "yellow" . dzenStrip+                     , ppWsSep    = ""+                     , ppSep      = ""+                     , ppLayout   = dzenColor "black" "#cccccc" .+                                    (\ x -> case x of+                                              "TilePrime Horizontal" -> " TTT "+                                              "TilePrime Vertical"   -> " []= "+                                              "Hinted Full"          -> " [ ] "+                                              _                      -> pad x+                                    )+                     , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape+                     }++-- | Some nice xmobar defaults.+xmobarPP :: PP+xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"+                     , ppTitle   = xmobarColor "green"  "" . shorten 40+                     , ppVisible = wrap "(" ")"+                     }++-- | The options that sjanssen likes to use with xmobar, as an+-- example.  Note the use of 'xmobarColor' and the record update on+-- 'defaultPP'.+sjanssenPP :: PP+sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black"+                       , ppTitle = xmobarColor "#00ee00" "" . shorten 120+                       }++-- | The options that byorgey likes to use with dzen, as another example.+byorgeyPP :: PP+byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces+                      , ppHidden  = dzenColor "black"  "#a8a3f7" . pad+                      , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad+                      , ppUrgent  = dzenColor "red"    "yellow"+                      , ppSep     = " | "+                      , ppWsSep   = ""+                      , ppTitle   = shorten 70+                      , ppOrder   = reverse+                      }+  where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']+                                       then pad wsId+                                       else ""+
+ XMonad/Hooks/EventHook.hs view
@@ -0,0 +1,107 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.EventHook+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier that implements an event hook at the layout level.+--+-- Since it operates at the 'Workspace' level, it will install itself+-- on the first current 'Workspace' and will broadcast a 'Message' to+-- all other 'Workspace's not to handle events.+-----------------------------------------------------------------------------++module XMonad.Hooks.EventHook+    ( -- * Usage+      -- $usage++      -- * Writing a hook+      -- $hook+      EventHook (..)+    , eventHook+    , HandleEvent+    ) where++import Data.Maybe++import XMonad+import XMonad.StackSet (Workspace (..), currentTag)++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.EventHook+--+-- Then edit your @layoutHook@ by adding the 'eventHook':+--+-- > layoutHook = eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc..+--+-- and then:+--+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- $hook+-- Writing a hook is very simple.+--+-- This is a basic example to log all events:+--+-- > data EventHookExample = EventHookExample deriving ( Show, Read )+-- > instance EventHook EventHookExample where+-- >     handleEvent _ e = io $ hPutStrLn stderr . show $ e --return ()+--+-- This is an 'EventHook' to log mouse button events:+--+-- > data EventHookButton = EventHookButton deriving ( Show, Read )+-- > instance EventHook EventHookButton where+-- >    handleEvent _ (ButtonEvent {ev_window = w}) = do+-- >         io $ hPutStrLn stderr $ "This is a button event on window " ++ (show w)+-- >    handleEvent _ _ = return ()+--+-- Obviously you can compose event hooks:+--+-- > layoutHook = eventHook EventHookButton $ eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc..++eventHook :: EventHook eh => eh -> l a -> (HandleEvent eh l) a+eventHook = HandleEvent Nothing True++class (Read eh, Show eh) => EventHook eh where+    handleEvent :: eh -> Event -> X ()+    handleEvent _ _ = return ()++data HandleEvent eh l a = HandleEvent (Maybe WorkspaceId) Bool eh (l a) deriving ( Show, Read )++data EventHandleMsg = HandlerOff deriving ( Typeable )+instance Message EventHandleMsg++instance (EventHook eh, LayoutClass l a) => LayoutClass (HandleEvent eh l) a where+    runLayout (Workspace i (HandleEvent Nothing True eh l) ms) r = do+      broadcastMessage HandlerOff+      iws       <- gets (currentTag . windowset)+      (wrs, ml) <- runLayout (Workspace i l ms) r+      return (wrs, Just $ HandleEvent (Just iws) True eh (fromMaybe l ml))++    runLayout (Workspace i (HandleEvent mi b eh l) ms) r = do+      (wrs, ml) <- runLayout (Workspace i l ms) r+      return (wrs, Just $ HandleEvent mi b eh (fromMaybe l ml))++    handleMessage (HandleEvent i True eh l) m+        | Just HandlerOff <- fromMessage m = return . Just $ HandleEvent i False eh l+        | Just e          <- fromMessage m = handleMessage l (SomeMessage e) >>= \ml ->+                                             handleEvent eh e >>+                                             maybe (return Nothing) (\l' -> return . Just $ HandleEvent i True eh l') ml+    handleMessage (HandleEvent i b eh l) m = handleMessage l m >>=+                                             maybe (return Nothing) (\l' -> return . Just $ HandleEvent i b    eh l')++    description (HandleEvent _ _ _ l) = description l
+ XMonad/Hooks/EwmhDesktops.hs view
@@ -0,0 +1,225 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.EwmhDesktops+-- Copyright    : (c) 2007, 2008 Joachim Breitner <mail@joachim-breitner.de>+-- License      : BSD+--+-- Maintainer   : Joachim Breitner <mail@joachim-breitner.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- Makes xmonad use the EWMH hints to tell panel applications about its+-- workspaces and the windows therein. It also allows the user to interact+-- with xmonad by clicking on panels and window lists.+-----------------------------------------------------------------------------+module XMonad.Hooks.EwmhDesktops (+    -- * Usage+    -- $usage+    ewmhDesktopsLogHook,+    ewmhDesktopsLogHookCustom,+    ewmhDesktopsEventHook+    ) where++import Codec.Binary.UTF8.String (encode)+import Data.List+import Data.Maybe+import Data.Monoid++import XMonad+import Control.Monad+import qualified XMonad.StackSet as W++import XMonad.Hooks.SetWMName+import XMonad.Util.WorkspaceCompare++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad+-- > import XMonad.Hooks.EwmhDesktops+-- >+-- > myLogHook :: X ()+-- > myLogHook = ewmhDesktopsLogHook+-- >+-- > myHandleEventHook = ewmhDesktopsEventHook+-- >+-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook, logHook = myLogHook }+--+-- 'avoidStruts' is used to automatically leave space for dock programs, and+-- can be found in 'XMonad.Hooks.ManageDocks'.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+++++-- |+-- Notifies pagers and window lists, such as those in the gnome-panel+-- of the current state of workspaces and windows.+ewmhDesktopsLogHook :: X ()+ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id+++-- |+-- Generalized version of ewmhDesktopsLogHook that allows an arbitrary+-- user-specified function to transform the workspace list (post-sorting)+ewmhDesktopsLogHookCustom :: ([WindowSpace] -> [WindowSpace]) -> X ()+ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do+    sort' <- getSortByIndex+    let ws = f $ sort' $ W.workspaces s++    setSupported++    -- Number of Workspaces+    setNumberOfDesktops (length ws)++    -- Names thereof+    setDesktopNames (map W.tag ws)++    -- all windows, with focused windows last+    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws+    setClientList wins++    -- Current desktop+    case (elemIndex (W.currentTag s) $ map W.tag ws) of+      Nothing -> return ()+      Just curr -> do+        setCurrentDesktop curr++        -- Per window Desktop+        -- To make gnome-panel accept our xinerama stuff, we display+        -- all visible windows on the current desktop.+        forM_ (W.current s : W.visible s) $ \x ->+            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do+                setWindowDesktop win curr++    forM_ (W.hidden s) $ \w ->+        case elemIndex (W.tag w) (map W.tag ws) of +          Nothing -> return ()+          Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do+                         setWindowDesktop win wn++    setActiveWindow++    return ()++-- |+-- Intercepts messages from pagers and similar applications and reacts on them.+-- Currently supports:+--+--  * _NET_CURRENT_DESKTOP (switching desktops)+--+--  * _NET_WM_DESKTOP (move windows to other desktops)+--+--  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)+--+ewmhDesktopsEventHook :: Event -> X All+ewmhDesktopsEventHook e = handle e >> return (All True)++handle :: Event -> X ()+handle ClientMessageEvent {+               ev_window = w,+               ev_message_type = mt,+               ev_data = d+       } = withWindowSet $ \s -> do+       sort' <- getSortByIndex+       let ws = sort' $ W.workspaces s++       a_cd <- getAtom "_NET_CURRENT_DESKTOP"+       a_d <- getAtom "_NET_WM_DESKTOP"+       a_aw <- getAtom "_NET_ACTIVE_WINDOW"+       a_cw <- getAtom "_NET_CLOSE_WINDOW"+       a_ignore <- mapM getAtom ["XMONAD_TIMER"]+       if  mt == a_cd then do+               let n = fromIntegral (head d)+               if 0 <= n && n < length ws then+                       windows $ W.view (W.tag (ws !! n))+                 else  trace $ "Bad _NET_CURRENT_DESKTOP with data[0]="++show n+        else if mt == a_d then do+               let n = fromIntegral (head d)+               if 0 <= n && n < length ws then+                       windows $ W.shiftWin (W.tag (ws !! n)) w+                 else  trace $ "Bad _NET_DESKTOP with data[0]="++show n+        else if mt == a_aw then do+               windows $ W.focusWindow w+        else if mt == a_cw then do+               killWindow w+        else if mt `elem` a_ignore then do+	       return ()+        else return ()+            -- no warnings about unknown messages for now+            --trace $ "Unknown ClientMessageEvent " ++ show mt+handle _ = 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 $ concatMap ((++[0]) . encode) names+    io $ changeProperty8 dpy r a c propModeReplace names'++setClientList :: [Window] -> X ()+setClientList wins = withDisplay $ \dpy -> do+    -- (What order do we really need? Something about age and stacking)+    r <- asks theRoot+    c <- getAtom "WINDOW"+    a <- getAtom "_NET_CLIENT_LIST"+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)+    a' <- getAtom "_NET_CLIENT_LIST_STACKING"+    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)++setWindowDesktop :: (Integral a) => Window -> a -> X ()+setWindowDesktop win i = withDisplay $ \dpy -> do+    a <- getAtom "_NET_WM_DESKTOP"+    c <- getAtom "CARDINAL"+    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]++setSupported :: X ()+setSupported = withDisplay $ \dpy -> do+    r <- asks theRoot+    a <- getAtom "_NET_SUPPORTED"+    c <- getAtom "ATOM"+    supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"+                         ,"_NET_NUMBER_OF_DESKTOPS"+                         ,"_NET_CLIENT_LIST"+                         ,"_NET_CLIENT_LIST_STACKING"+                         ,"_NET_CURRENT_DESKTOP"+                         ,"_NET_DESKTOP_NAMES"+                         ,"_NET_ACTIVE_WINDOW"+                         ,"_NET_WM_DESKTOP"+                         ,"_NET_WM_STRUT"+                         ]+    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)++    setWMName "xmonad"++setActiveWindow :: X ()+setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do+    let w = fromMaybe none (W.peek s)+    r <- asks theRoot+    a <- getAtom "_NET_ACTIVE_WINDOW"+    c <- getAtom "WINDOW"+    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]
+ XMonad/Hooks/FadeInactive.hs view
@@ -0,0 +1,90 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.FadeInactive+-- Copyright    : (c) 2008 Justin Bogner <mail@justinbogner.com>+-- License      : BSD+--+-- Maintainer   : Justin Bogner <mail@justinbogner.com>+-- Stability    : unstable+-- Portability  : unportable+--+-- Makes XMonad set the _NET_WM_WINDOW_OPACITY atom for inactive windows,+-- which causes those windows to become slightly translucent if something+-- like xcompmgr is running+-----------------------------------------------------------------------------+module XMonad.Hooks.FadeInactive (+    -- * Usage+    -- $usage+    setOpacity,+    isUnfocused,+    fadeIn,+    fadeOut,+    fadeInactiveLogHook,+    fadeOutLogHook+    ) where++import XMonad+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+-- > import XMonad.Hooks.FadeInactive+-- >+-- > myLogHook :: X ()+-- > myLogHook = fadeInactiveLogHook fadeAmount+-- >     where fadeAmount = 0xdddddddd+-- >+-- > main = xmonad defaultConfig { logHook = myLogHook }+--+-- fadeAmount can be any integer+-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>+-- or something similar for this to do anything+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- |+-- sets the opacity of a window+setOpacity :: Window -> Integer -> X ()+setOpacity w t = withDisplay $ \dpy -> do+    a <- getAtom "_NET_WM_WINDOW_OPACITY"+    c <- getAtom "CARDINAL"+    io $ changeProperty32 dpy w a c propModeReplace [fromIntegral t]++-- |+-- fades a window out by setting the opacity+fadeOut :: Integer -> Window -> X ()+fadeOut amt = flip setOpacity amt++-- |+-- makes a window completely opaque+fadeIn :: Window -> X ()+fadeIn = flip setOpacity 0xffffffff++-- |+-- lowers the opacity of inactive windows to the specified amount+fadeInactiveLogHook :: Integer -> X ()+fadeInactiveLogHook amt = fadeOutLogHook isUnfocused amt++-- | returns True if the window doesn't have the focus.+isUnfocused :: Window -> X Bool+isUnfocused w = withWindowSet $ \s -> return $+                case W.stack . W.workspace . W.current $ s of+                  Nothing -> False+                  Just stack -> W.focus stack /= w++-- | fades out every window that satisfies a given property.+fadeOutLogHook :: (Window -> X Bool) -> Integer -> X ()+fadeOutLogHook p amt = withWindowSet $ \s -> do+    let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) +++                      concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)+    mapM_ fadeIn =<< filterM (fmap not . p) visibleWins+    mapM_ (fadeOut amt) =<< filterM p visibleWins
+ XMonad/Hooks/FloatNext.hs view
@@ -0,0 +1,157 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.FloatNext+-- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Hook and keybindings for automatically sending the next +-- spawned window(s) to the floating layer.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.FloatNext ( -- * Usage+                                -- $usage++                                -- * The hook+                                floatNextHook++                                -- * Actions+                              , floatNext+                              , toggleFloatNext+                              , floatAllNew+                              , toggleFloatAllNew++                                -- * Queries+                              , willFloatNext+                              , willFloatAllNew++                                -- * 'DynamicLog' utilities+                                -- $pp+                              , willFloatNextPP+                              , willFloatAllNewPP+                              , runLogHook ) where++import Prelude hiding (all)++import XMonad++import Control.Monad (join)+import Control.Applicative ((<$>))+import Control.Arrow (first, second)+import Control.Concurrent.MVar+import System.IO.Unsafe (unsafePerformIO)+++{- Helper functions -}++modifyMVar2 :: MVar a -> (a -> a) -> IO ()+modifyMVar2 v f = modifyMVar_ v (return . f)++_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()+_set f b = io $ modifyMVar2 floatModeMVar (f $ const b)++_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()+_toggle f = io $ modifyMVar2 floatModeMVar (f not)++_get :: ((Bool, Bool) -> a) -> X a+_get f = io $ f <$> readMVar floatModeMVar++_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)+_pp f s st = _get f >>= \b -> if b then return $ Just $ st s else return Nothing+++{- The current state is kept here -}++floatModeMVar :: MVar (Bool, Bool)+floatModeMVar = unsafePerformIO $ newMVar (False, False)+++-- $usage+-- This module provides actions (that can be set as keybindings)+-- to automatically send the next spawned window(s) to the floating +-- layer.+--+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:+-- +-- > import XMonad.Hooks.FloatNext+--+-- and adding 'floatNextHook' to your 'ManageHook':+--+-- > myManageHook = floatNextHook <+> manageHook defaultConfig+--+-- The 'floatNext' and 'toggleFloatNext' functions can be used in key+-- bindings to float the next spawned window:+--+-- > , ((modMask, xK_e), toggleFloatNext)+--+-- 'floatAllNew' and 'toggleFloatAllNew' are similar but float all+-- spawned windows until disabled again.+--+-- > , ((modMask, xK_r), toggleFloatAllNew)+++-- | This 'ManageHook' will selectively float windows as set+-- by 'floatNext' and 'floatAllNew'.+floatNextHook :: ManageHook+floatNextHook = do (next, all) <- io $ takeMVar floatModeMVar+                   io $ putMVar floatModeMVar (False, all)+                   if next || all then doFloat else idHook+++-- | @floatNext True@ arranges for the next spawned window to be+-- sent to the floating layer, @floatNext False@ cancels it.+floatNext :: Bool -> X ()+floatNext = _set first++toggleFloatNext :: X ()+toggleFloatNext = _toggle first++-- | @floatAllNew True@ arranges for new windows to be+-- sent to the floating layer, @floatAllNew False@ cancels it+floatAllNew :: Bool -> X ()+floatAllNew = _set second++toggleFloatAllNew :: X ()+toggleFloatAllNew = _toggle second+++-- | Whether the next window will be set floating+willFloatNext :: X Bool+willFloatNext = _get fst++-- | Whether new windows will be set floating+willFloatAllNew :: X Bool+willFloatAllNew = _get snd+++-- $pp+-- The following functions are used to display the current+-- state of 'floatNext' and 'floatAllNew' in your +-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.+-- 'willFloatNextPP' and 'willFloatAllNewPP' should be added+-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your +-- 'XMonad.Hooks.DynamicLog.PP'.+--+-- Use 'runLogHook' to refresh the output of your 'logHook', so+-- that the effects of a 'floatNext'/... will be visible+-- immediately:+-- +-- > , ((modMask, xK_e), toggleFloatNext >> runLogHook)+--+-- The @String -> String@ parameters to 'willFloatNextPP' and+-- 'willFloatAllNewPP' will be applied to their output, you +-- can use them to set the text color, etc., or you can just+-- pass them 'id'.+ +willFloatNextPP :: (String -> String) -> X (Maybe String)+willFloatNextPP = _pp fst "Next"++willFloatAllNewPP :: (String -> String) -> X (Maybe String)+willFloatAllNewPP = _pp snd "All"++runLogHook :: X ()+runLogHook = join $ asks $ logHook . config
+ XMonad/Hooks/InsertPosition.hs view
@@ -0,0 +1,74 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.InsertPosition+-- Copyright   :  (c) 2009 Adam Vogt+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  vogt.adam@gmail.com+-- Stability   :  unstable+-- Portability :  portable+--+-- Configure where new windows should be added and which window should be+-- focused.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.InsertPosition (+    -- * Usage+    -- $usage+    insertPosition+    ,Focus(..), Position(..)+    ) where++import XMonad(ManageHook, MonadReader(ask))+import qualified XMonad.StackSet as W+import Control.Applicative((<$>))+import Data.Maybe(fromMaybe)+import Data.List(find)+import Data.Monoid(Endo(Endo))++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.InsertPosition+-- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook }+--+-- You should you put the manageHooks that use 'doShift' to take effect+-- /before/ 'insertPosition', so that the window order will be consistent.+-- Because ManageHooks compose from right to left (like function composition+-- '.'), this means that 'insertPosition' should be the leftmost ManageHook.++data Position = Master | End | Above | Below+data Focus = Newer | Older++-- | insertPosition. A manage hook for placing new windows. XMonad's default is+-- the same as using: @insertPosition Above Newer@.+insertPosition :: Position -> Focus -> ManageHook+insertPosition pos foc = Endo . g <$> ask+  where+    g w = viewingWs w (updateFocus w . ins w . W.delete w)+    ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $+        case pos of+            Master -> W.insertUp w . W.focusMaster+            End    -> insertDown w . W.modify' focusLast'+            Above  -> W.insertUp w+            Below  -> insertDown w+    updateFocus =+        case foc of+            Older -> const id+            Newer -> W.focusWindow++-- | Modify the StackSet when the workspace containing w is focused+viewingWs :: (Eq a, Eq s, Eq i, Show i) =>a-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)-> W.StackSet i l a s sd-> W.StackSet i l a s sd+viewingWs w f = do+    i <- W.tag . W.workspace . W.current+    ws <- find (elem w . W.integrate' . W.stack) . W.workspaces+    maybe id (fmap (W.view i . f) . W.view . W.tag) ws++-- | 'insertDown' and 'focusLast' belong in XMonad.StackSet?+insertDown :: (Eq a) => a -> W.StackSet i l a s sd -> W.StackSet i l a s sd+insertDown w = W.swapDown . W.insertUp w++focusLast' ::  W.Stack a -> W.Stack a+focusLast' st = let ws = W.integrate st+    in W.Stack (last ws) (tail $ reverse ws) []
+ XMonad/Hooks/ManageDocks.hs view
@@ -0,0 +1,236 @@+{-# 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, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,+    ToggleStruts(..), Direction(..), calcGap+    ) where+++-----------------------------------------------------------------------------+import XMonad+import Foreign.C.Types (CLong)+import Control.Monad+import XMonad.Layout.LayoutModifier+import XMonad.Util.WindowProperties (getProp32s)++import Data.List (delete)++-- $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 and de-manages them, so that xmonad does not try to tile+-- them.  To enable it:+--+-- > manageHook = ... <+> manageDocks+--+-- The second component is a layout modifier that prevents windows+-- from overlapping these dock windows.  It is intended to replace+-- xmonad's so-called \"gap\" support.  First, you must add it to your+-- list of layouts:+--+-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)+-- >                   where  tall = Tall 1 (3/100) (1/2)+--+-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding+-- similar to:+--+-- > ,((modMask x, xK_b     ), sendMessage ToggleStruts)+--+-- If you have multiple docks, you can toggle their gaps individually.+-- For example, to toggle only the top gap:+--+-- > ,((modMask x .|. controlMask, xK_t), sendMessage $ ToggleStrut U)+--+-- Similarly, you can use 'D', 'L', and 'R' to individually toggle+-- gaps on the bottom, left, or right.+--+-- If you want certain docks to be avoided but others to be covered by+-- default, you can manually specify the sides of the screen on which+-- docks should be avoided, using 'avoidStrutsOn'.  For example:+--+-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)+--+-- /Important note/: if you are switching from manual gaps+-- (defaultGaps in your config) to avoidStruts (recommended, since+-- manual gaps will probably be phased out soon), be sure to switch+-- off all your gaps (with mod-b) /before/ reloading your config with+-- avoidStruts!  Toggling struts with a 'ToggleStruts' message will+-- not work unless your gaps are set to zero.+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+--++-- | An enumeration of the four cardinal directions\/sides of the+--   screen.+--+--   Ideally this would go in its own separate module in Util,+--   but ManageDocks is angling for inclusion into the xmonad core,+--   so keep the dependencies to a minimum.+data Direction = U   -- ^ Up\/top+               | D   -- ^ Down\/bottom+               | R   -- ^ Right+               | L   -- ^ Left+  deriving ( Read, Show, Eq, Ord, Enum, Bounded )++-- | Detects if the given window is of type DOCK and if so, reveals+--   it, but does not manage it. If the window has the STRUT property+--   set, adjust the gap accordingly.+manageDocks :: ManageHook+manageDocks = checkDock --> doIgnore++-- | Checks if a window is a DOCK or DESKTOP window+checkDock :: Query Bool+checkDock = ask >>= \w -> liftX $ do+    dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"+    desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"+    mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w+    case mbr of+        Just [r] -> return $ elem (fromIntegral r) [dock, desk]+        _        -> return False++-- | Gets the STRUT config, if present, in xmonad gap order+getStrut :: Window -> X [Strut]+getStrut w = do+    msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w+    case msp of+        Just sp -> return $ parseStrutPartial sp+        Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w+ where+    parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]+    parseStrut _ = []++    parseStrutPartial [l, r, t, b, ly1, ly2, ry1, ry2, tx1, tx2, bx1, bx2]+     = filter (\(_, n, _, _) -> n /= 0)+        [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)]+    parseStrutPartial _ = []++-- | Goes through the list of windows and find the gap so that all+--   STRUT settings are satisfied.+calcGap :: [Direction] -> X (Rectangle -> Rectangle)+calcGap ss = 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 <- (filter careAbout . concat) `fmap` mapM getStrut wins++    -- we grab the window attributes of the root window rather than checking+    -- the width of the screen because xlib caches this info and it tends to+    -- be incorrect after RAndR+    wa <- io $ getWindowAttributes dpy rootw+    let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)+    return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts+  where careAbout (s,_,_,_) = s `elem` ss++-- | Adjust layout automagically: don't cover up any docks, status+--   bars, etc.+avoidStruts :: LayoutClass l a => l a -> ModifiedLayout AvoidStruts l a+avoidStruts = avoidStrutsOn [U,D,L,R]++-- | Adjust layout automagically: don't cover up docks, status bars,+--   etc. on the indicated sides of the screen.  Valid sides are U+--   (top), D (bottom), R (right), or L (left).+avoidStrutsOn :: LayoutClass l a =>+                 [Direction]+              -> l a+              -> ModifiedLayout AvoidStruts l a+avoidStrutsOn ss = ModifiedLayout (AvoidStruts ss)++data AvoidStruts a = AvoidStruts [Direction] deriving ( Read, Show )++-- | Message type which can be sent to an 'AvoidStruts' layout+--   modifier to alter its behavior.+data ToggleStruts = ToggleStruts+                  | ToggleStrut Direction+  deriving (Read,Show,Typeable)++instance Message ToggleStruts++instance LayoutModifier AvoidStruts a where+    modifyLayout (AvoidStruts ss) w r = do+        nr <- fmap ($ r) (calcGap ss)+        runLayout w nr++    handleMess (AvoidStruts ss) m+        | Just ToggleStruts    <- fromMessage m = return $ Just $ AvoidStruts (toggleAll ss)+        | Just (ToggleStrut s) <- fromMessage m = return $ Just $ AvoidStruts (toggleOne s ss)+        | otherwise = return Nothing+      where toggleAll []   = [U,D,L,R]+            toggleAll _    = []+            toggleOne x xs | x `elem` xs = delete x xs+                           | otherwise   = x : xs+++-- | (Direction, height\/width, initial pixel, final pixel).++type Strut = (Direction, CLong, CLong, CLong)++-- | (Initial x pixel, initial y pixel,+--    final x pixel, final y pixel).++type RectC = (CLong, CLong, CLong, CLong)++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++-- | Invertible conversion.++r2c :: Rectangle -> RectC+r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)++-- | Invertible conversion.++c2r :: RectC -> Rectangle+c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)++-- TODO: Add these QuickCheck properties to the test suite, along with+-- suitable Arbitrary instances.++-- prop_r2c_c2r :: RectC -> Bool+-- prop_r2c_c2r r = r2c (c2r r) == r++-- prop_c2r_r2c :: Rectangle -> Bool+-- prop_c2r_r2c r = c2r (r2c r) == r++reduce :: RectC -> Strut -> RectC -> RectC+reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of+    L | p (y0, y1) -> (mx x0 sx0    , y0       , x1       , y1       )+    R | p (y0, y1) -> (x0           , y0       , mn x1 sx1, y1       )+    U | p (x0, x1) -> (x0           , mx y0 sy0, x1       , y1       )+    D | p (x0, x1) -> (x0           , y0       , x1       , mn y1 sy1)+    _              -> (x0           , y0       , x1       , y1       )+ where+    mx a b = max a (b + n)+    mn a b = min a (b - n)+    p r = r `overlaps` (l, h)++-- | Do the two ranges overlap?+--+-- Precondition for every input range @(x, y)@: @x '<=' y@.+--+-- A range @(x, y)@ is assumed to include every pixel from @x@ to @y@.++overlaps :: Ord a => (a, a) -> (a, a) -> Bool+(a, b) `overlaps` (x, y) =+  inRange (a, b) x || inRange (a, b) y || inRange (x, y) a+  where+  inRange (i, j) k = i <= k && k <= j
+ XMonad/Hooks/ManageHelpers.hs view
@@ -0,0 +1,208 @@+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Hooks.ManageHelpers+-- Copyright    : (c) Lukas Mai+-- License      : BSD+--+-- Maintainer   : Lukas Mai <l.mai@web.de>+-- Stability    : unstable+-- Portability  : unportable+--+-- This module provides helper functions to be used in @manageHook@. Here's+-- how you might use this:+--+-- > import XMonad.Hooks.ManageHelpers+-- > main =+-- >     xmonad defaultConfig{+-- >         ...+-- >         manageHook = composeOne [+-- >             isKDETrayWindow -?> doIgnore,+-- >             transience,+-- >             isFullscreen -?> doFullFloat,+-- >             resource =? "stalonetray" -?> doIgnore+-- >         ],+-- >         ...+-- >     }++module XMonad.Hooks.ManageHelpers (+    Side(..),+    composeOne,+    (-?>), (/=?), (<==?), (</=?), (-->>), (-?>>),+    isInProperty,+    isKDETrayWindow,+    isFullscreen,+    isDialog,+    pid,+    transientTo,+    maybeToDefinite,+    MaybeManageHook,+    transience,+    transience',+    doRectFloat,+    doFullFloat,+    doCenterFloat,+    doSideFloat,+    doHideIgnore+) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Util.WindowProperties (getProp32s)++import Data.Maybe+import Data.Monoid++import System.Posix (ProcessID)++-- | Denotes a side of a screen. @S@ stands for South, @NE@ for Northwest+-- etc. @C@ stands for Center.+data Side = SC | NC | CE | CW | SE | SW | NE | NW | C+    deriving (Read, Show, Eq)++-- | A ManageHook that may or may not have been executed; the outcome is embedded in the Maybe+type MaybeManageHook = Query (Maybe (Endo WindowSet))+-- | A grouping type, which can hold the outcome of a predicate Query.+-- This is analogous to group types in regular expressions.+-- TODO: create a better API for aggregating multiple Matches logically+data Match a = Match Bool a++-- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as+-- a candidate returns a 'Just' value, effectively running only the first match+-- (whereas 'composeAll' continues and executes all matching rules).+composeOne :: [MaybeManageHook] -> ManageHook+composeOne = foldr try idHook+    where+    try q z = do+        x <- q+        case x of+            Just h -> return h+            Nothing -> z++infixr 0 -?>, -->>, -?>>++-- | q \/=? x. if the result of q equals x, return False+(/=?) :: Eq a => Query a -> a -> Query Bool+q /=? x = fmap (/= x) q++-- | q <==? x. if the result of q equals x, return True grouped with q+(<==?) :: Eq a => Query a -> a -> Query (Match a)+q <==? x = fmap (`eq` x) q+    where+    eq q' x' = Match (q' == x') q'++-- | q <\/=? x. if the result of q notequals x, return True grouped with q+(</=?) :: Eq a => Query a -> a -> Query (Match a)+q </=? x = fmap (`neq` x) q+    where+    neq q' x' = Match (q' /= x') q'++-- | A helper operator for use in 'composeOne'. It takes a condition and an action;+-- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will+-- go on and try the next rule.+(-?>) :: Query Bool -> ManageHook -> MaybeManageHook+p -?> f = do+    x <- p+    if x then fmap Just f else return Nothing++-- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.+(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook+p -->> f = do+    Match b m <- p+    if b then (f m) else mempty++-- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.+(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook+p -?>> f = do+    Match b m <- p+    if b then fmap  Just (f m) else return Nothing++-- | A predicate to check whether a window is a KDE system tray icon.+isKDETrayWindow :: Query Bool+isKDETrayWindow = ask >>= \w -> liftX $ do+    r <- getProp32s "_KDE_NET_WM_SYSTEM_TRAY_WINDOW_FOR" w+    return $ case r of+        Just [_] -> True+        _ -> False++-- | Helper to check if a window property contains certain value.+isInProperty :: String -> String -> Query Bool+isInProperty p v = ask >>= \w -> liftX $ do+    va <- getAtom v+    r <- getProp32s p w+    return $ case r of+        Just xs -> fromIntegral va `elem` xs+        _ -> False++-- | A predicate to check whether a window wants to fill the whole screen.+-- See also 'doFullFloat'.+isFullscreen :: Query Bool+isFullscreen = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_FULLSCREEN"++-- | A predicate to check whether a window is a dialog.+isDialog :: Query Bool+isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"++pid :: Query (Maybe ProcessID)+pid = ask >>= \w -> liftX $ do+    p <- getProp32s "_NET_WM_PID" w+    return $ case p of+        Just [x] -> Just (fromIntegral x)+        _        -> Nothing++-- | A predicate to check whether a window is Transient.+-- It holds the result which might be the window it is transient to+-- or it might be 'Nothing'.+transientTo :: Query (Maybe Window)+transientTo = do+    w <- ask+    d <- (liftX . asks) display+    liftIO $ getTransientForHint d w++-- | A convenience 'MaybeManageHook' that will check to see if a window+-- is transient, and then move it to its parent.+transience :: MaybeManageHook+transience = transientTo </=? Nothing -?>> move+    where+    move mw = maybe idHook (doF . move') mw+    move' w s = maybe s (`W.shift` s) (W.findTag w s)++-- | 'transience' set to a 'ManageHook'+transience' :: ManageHook+transience' = maybeToDefinite transience++-- | converts 'MaybeManageHook's to 'ManageHook's+maybeToDefinite :: MaybeManageHook -> ManageHook+maybeToDefinite = fmap (fromMaybe mempty)+++-- | Floats the new window in the given rectangle.+doRectFloat :: W.RationalRect  -- ^ The rectangle to float the window in. 0 to 1; x, y, w, h.+            -> ManageHook+doRectFloat r = ask >>= \w -> doF (W.float w r)++-- | Floats the window and makes it use the whole screen. Equivalent to+-- @'doRectFloat' $ 'W.RationalRect' 0 0 1 1@.+doFullFloat :: ManageHook+doFullFloat = doRectFloat $ W.RationalRect 0 0 1 1++-- | Floats a new window with its original size on the specified side of a+-- screen+doSideFloat :: Side -> ManageHook+doSideFloat side = ask >>= \w -> doF . W.float w . move . snd =<< liftX (floatLocation w)+    where+    move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h+        where+        cx =      if side `elem` [SC,C ,NC] then (1-w)/2+             else if side `elem` [SW,CW,NW] then 0+             else {- side `elem` [SE,CE,NE] -}   1-w+        cy =      if side `elem` [CE,C ,CW] then (1-h)/2+             else if side `elem` [NE,NC,NW] then 0+             else {- side `elem` [SE,SC,SW] -}   1-h++-- | Floats a new window with its original size, but centered.+doCenterFloat :: ManageHook+doCenterFloat = doSideFloat C++-- | Hides window and ignores it.+doHideIgnore :: ManageHook+doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)
+ XMonad/Hooks/Place.hs view
@@ -0,0 +1,460 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.Place+-- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Automatic placement of floating windows.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.Place   ( -- * Usage+                              -- $usage+                                                            +                              -- * Placement actions+                              placeFocused+                            , placeHook++                              -- * Placement policies+                              -- $placements+                            , Placement+                            , smart+                            , simpleSmart+                            , fixed+                            , underMouse+                            , inBounds+                            , withGaps++                              -- * Others+                            , purePlaceWindow ) where+++import XMonad+import qualified XMonad.StackSet as S++import XMonad.Layout.WindowArranger+import XMonad.Actions.FloatKeys++import qualified Data.Map as M+import Data.Ratio ((%))+import Data.List (sortBy, minimumBy, partition)+import Data.Maybe (maybe, fromMaybe, catMaybes)+import Data.Monoid (Endo(..))+import Control.Monad (guard, join)+import Control.Monad.Trans (lift)++-- $usage+-- This module provides a 'ManageHook' that automatically places+-- floating windows at appropriate positions on the screen, as well+-- as an 'X' action to manually trigger repositioning.+--+-- You can use this module by including the following in your @~\/.xmonad\/xmonad.hs@:+-- +-- > import XMonad.Hooks.Place+--+-- and adding 'placeHook' to your 'manageHook', for example:+--+-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart+-- >                                              <+> manageHook defaultConfig }+--+-- Note that 'placeHook' should be applied after most other hooks, especially hooks +-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from+-- right to left, this means that 'placeHook' should be the /first/ hook in your chain.+--+-- You can also define a key to manually trigger repositioning with 'placeFocused' by+-- adding the following to your keys definition:+--+-- > , ((modMask, xK_w), placeFocused simpleSmart)+--+-- Both 'placeHook' and 'placeFocused' take a 'Placement' parameter, which specifies+-- the placement policy to use (smart, under the mouse, fixed position, etc.). See +-- 'Placement' for a list of available policies.++++{- Placement policies -}++-- $placements+-- Placement policies determine how windows will be placed by 'placeFocused' and 'placeHook'.+--+-- A few examples:+--+-- * Basic smart placement+--+-- > myPlacement = simpleSmart+--+-- * Under the mouse (pointer at the top-left corner), but constrained+--   inside of the screen area+--+-- > myPlacement = inBounds (underMouse (0, 0))+--+-- * Smart placement with a preference for putting windows near+-- the center of the screen, and with 16px gaps at the top and bottom+-- of the screen where no window will be placed+--+-- > myPlacement = withGaps (16,0,16,0) (smart (0.5,0.5))+++-- | The type of placement policies+data Placement = Smart (Rational, Rational)+               | Fixed (Rational, Rational)+               | UnderMouse (Rational, Rational)+               | Bounds (Dimension, Dimension, Dimension, Dimension) Placement+                 deriving (Show, Read, Eq)+++-- | Try to place windows with as little overlap as possible+smart :: (Rational, Rational) -- ^ Where the window should be placed inside+                              -- the available area. See 'fixed'.+      -> Placement+smart = Smart++simpleSmart :: Placement+simpleSmart = inBounds $ smart (0,0)+++-- | Place windows at a fixed position+fixed :: (Rational, Rational) -- ^ Where windows should go. +                              -- +                              --     * (0,0) -> top left of the screen +                              -- +                              --     * (1,0) -> top right of the screen+                              -- +                              --     * etc+      -> Placement+fixed = Fixed+++-- | Place windows under the mouse+underMouse :: (Rational, Rational) -- ^ Where the pointer should be relative to+                                   -- the window's frame; see 'fixed'.+           -> Placement+underMouse = UnderMouse+++-- | Apply the given placement policy, constraining the +-- placed windows inside the screen boundaries.+inBounds :: Placement -> Placement +inBounds = Bounds (0,0,0,0)+++-- | Same as 'inBounds', but allows specifying gaps along the screen's edges+withGaps :: (Dimension, Dimension, Dimension, Dimension) +         -- ^ top, right, bottom and left gaps+         -> Placement -> Placement+withGaps = Bounds++++{- Placement functions -}+++-- | Repositions the focused window according to a placement policy. Works for+-- both \"real\" floating windows and windows in a 'WindowArranger'-based+-- layout.+placeFocused :: Placement -> X ()+placeFocused p = withFocused $ \window -> do+                   info <- gets $ screenInfo . S.current . windowset+                   floats <- gets $ M.keys . S.floating . windowset+                   +                   r'@(Rectangle x' y' _ _) <- placeWindow p window info floats++                     -- use X.A.FloatKeys if the window is floating, send+                     -- a WindowArranger message otherwise.+                   case elem window floats of+                     True -> keysMoveWindowTo (x', y') (0, 0) window+                     False -> sendMessage $ SetGeometry r'+++-- | Hook to automatically place windows when they are created.+placeHook :: Placement -> ManageHook+placeHook p = do window <- ask+                 r <- Query $ lift $ getWindowRectangle window+                 allRs <- Query $ lift $ getAllRectangles+                 pointer <- Query $ lift $ getPointer window++                 return $ Endo $ \theWS -> fromMaybe theWS $+                   do let currentRect = screenRect $ S.screenDetail $ S.current theWS+                          floats = M.keys $ S.floating theWS++                      guard(window `elem` floats )+                      +                        -- Look for the workspace(s) on which the window is to be +                        -- spawned. Each of them also needs an associated screen+                        -- rectangle; for hidden workspaces, we use the current+                        -- workspace's screen.+                      let infos = filter ((window `elem`) . stackContents . S.stack . fst)+                                     $ [screenInfo $ S.current theWS]+                                        ++ (map screenInfo $ S.visible theWS)+                                        ++ zip (S.hidden theWS) (repeat currentRect)+                                           +                      guard(not $ null infos)++                      let (workspace, screen) = head infos+                          rs = catMaybes $ map (flip M.lookup allRs)+                               $ organizeClients workspace window floats+                          r' = purePlaceWindow p screen rs pointer r+                          newRect = r2rr screen r'+                          newFloats = M.insert window newRect (S.floating theWS)++                      return $ theWS { S.floating = newFloats }+++placeWindow :: Placement -> Window+            -> (S.Workspace WorkspaceId (Layout Window) Window, Rectangle)+                 -- ^ The workspace with reference to which the window should be placed,+                 -- and the screen's geometry.+            -> [Window]+                 -- ^ The list of floating windows.+            -> X Rectangle+placeWindow p window (ws, s) floats+  = do (r, rs, pointer) <- getNecessaryData window ws floats+       return $ purePlaceWindow p s rs pointer r+++-- | Compute the new position of a window according to a placement policy.+purePlaceWindow :: Placement -- ^ The placement strategy+                -> Rectangle -- ^ The screen+                -> [Rectangle] -- ^ The other visible windows+                -> (Position, Position) -- ^ The pointer's position.+                -> Rectangle -- ^ The window to be placed+                -> Rectangle+purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w +  = let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b))+    in checkBounds s' $ purePlaceWindow p' s' rs p w++purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w++purePlaceWindow (UnderMouse (rx, ry)) _ _ (px, py) (Rectangle _ _ w h)+  = Rectangle (px - truncate (rx * fi w)) (py - truncate (ry * fi h)) w h++purePlaceWindow (Smart ratios) s rs _ w+  = placeSmart ratios s rs (rect_width w) (rect_height w)+++-- | Helper: Places a Rectangle at a fixed position indicated by two Rationals+-- inside another,+placeRatio :: (Rational, Rational) -> Rectangle -> Rectangle -> Rectangle+placeRatio (rx, ry) (Rectangle x1 y1 w1 h1) (Rectangle _ _ w2 h2)+  = Rectangle (scale rx x1 (x1 + fi w1 - fi w2))+              (scale ry y1 (y1 + fi h1 - fi h2))+              w2 h2+++-- | Helper: Ensures its second parameter is contained inside the first+-- by possibly moving it.+checkBounds :: Rectangle -> Rectangle -> Rectangle+checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2)+  = Rectangle (max x1 (min (x1 + fi w1 - fi w2) x2))+              (max y1 (min (y1 + fi h1 - fi h2) y2))+              w2 h2++++++{- Utilities -}++scale :: (RealFrac a, Integral b) => a -> b -> b -> b+scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++r2rr :: Rectangle -> Rectangle -> S.RationalRect+r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)+  = S.RationalRect ((fi x-fi x0) % fi w0) +                   ((fi y-fi y0) % fi h0) +                   (fi w % fi w0) +                   (fi h % fi h0)++++{- Querying stuff -}++stackContents :: Maybe (S.Stack w) -> [w]+stackContents = maybe [] S.integrate++screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)+screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)++getWindowRectangle :: Window -> X Rectangle+getWindowRectangle window+  = do d <- asks display+       (_, x, y, w, h, _, _) <- io $ getGeometry d window+       +         -- We can't use the border width returned by+         -- getGeometry because it will be 0 if the+         -- window isn't mapped yet.+       b <- asks $ borderWidth . config++       return $ Rectangle x y (w + 2*b) (h + 2*b)++getAllRectangles :: X (M.Map Window Rectangle)+getAllRectangles = do ws <- gets windowset+                      let allWindows = join $ map (stackContents . S.stack)+                                         $ (S.workspace . S.current) ws+                                         : (map S.workspace . S.visible) ws+                                         ++ S.hidden ws+                      allRects <- mapM getWindowRectangle allWindows++                      return $ M.fromList $ zip allWindows allRects++organizeClients :: S.Workspace a b Window -> Window -> [Window] -> [Window]+organizeClients ws w floats +  = let (floatCs, layoutCs) = partition (`elem` floats) $ filter (/= w) +                              $ stackContents $ S.stack ws+    in reverse layoutCs ++ reverse floatCs+      -- About the ordering: the smart algorithm will overlap windows +      -- starting ith the head of the list. So:+      --  - we put the non-floating windows first since they'll+      --    probably be below the floating ones,+      --  - we reverse the lists, since the newer/more important+      --    windows are usually near the head.++getPointer :: Window -> X (Position, Position)+getPointer window = do d <- asks display+                       (_,_,_,x,y,_,_,_) <- io $ queryPointer d window+                       return (fi x,fi y)++-- | Return values are, in order: window's rectangle,+-- other windows' rectangles and pointer's coordinates.+getNecessaryData :: Window +                 -> S.Workspace WorkspaceId (Layout Window) Window+                 -> [Window]+                 -> X (Rectangle, [Rectangle], (Position, Position))+getNecessaryData window ws floats+  = do r <- getWindowRectangle window+       +       rs <- return (organizeClients ws window floats)+             >>= mapM getWindowRectangle++       pointer <- getPointer window+                        +       return (r, rs, pointer)+++++{- Smart placement algorithm -}++-- | Alternate representation for rectangles.+data SmartRectangle a = SR +  { sr_x0, sr_y0 :: a -- ^ Top left coordinates, inclusive+  , sr_x1, sr_y1 :: a -- ^ Bottom right coorsinates, exclusive+  } deriving (Show, Eq)++r2sr :: Rectangle -> SmartRectangle Position+r2sr (Rectangle x y w h) = SR x y (x + fi w) (y + fi h)++sr2r :: SmartRectangle Position -> Rectangle+sr2r (SR x0 y0 x1 y1) = Rectangle x0 y0 (fi $ x1 - x0) (fi $ y1 - y0)++width :: Num a => SmartRectangle a -> a+width r = sr_x1 r - sr_x0 r++height :: Num a => SmartRectangle a -> a+height r = sr_y1 r - sr_y0 r++isEmpty :: Real a => SmartRectangle a -> Bool+isEmpty r = (width r <= 0) || (height r <= 0)++contains :: Real a => SmartRectangle a -> SmartRectangle a -> Bool+contains r1 r2 = sr_x0 r1 <= sr_x0 r2+                 && sr_y0 r1 <= sr_y0 r2+                 && sr_x1 r1 >= sr_x1 r2+                 && sr_y1 r1 >= sr_y1 r2+++-- | Main placement function+placeSmart :: (Rational, Rational) -- ^ point of the screen where windows+                                   -- should be placed first, if possible.+           -> Rectangle -- ^ screen+           -> [Rectangle] -- ^ other clients+           -> Dimension -- ^ width+           -> Dimension -- ^ height+           -> Rectangle+placeSmart (rx, ry) s@(Rectangle sx sy sw sh) rs w h+  = let free = map sr2r $ findSpace (r2sr s) (map r2sr rs) (fi w) (fi h)+    in position free (scale rx sx (sx + fi sw - fi w)) +                     (scale ry sy (sy + fi sh - fi h)) +                     w h++-- | Second part of the algorithm: +-- Chooses the best position in which to place a window, +-- according to a list of free areas and an ideal position for+-- the top-left corner.+-- We can't use semi-open surfaces for this, so we go back to+-- X11 Rectangles/Positions/etc instead.+position :: [Rectangle] -- ^ Free areas+         -> Position -> Position -- ^ Ideal coordinates+         -> Dimension -> Dimension -- ^ Width and height of the window+         -> Rectangle+position rs x y w h = minimumBy distanceOrder $ map closest rs+  where distanceOrder r1 r2 +          = compare (distance (rect_x r1,rect_y r1) (x,y) :: Dimension)+                    (distance (rect_x r2,rect_y r2) (x,y) :: Dimension)+        distance (x1,y1) (x2,y2) = truncate $ (sqrt :: Double -> Double) +                                   $ fi $ (x1 - x2)^(2::Int) +                                        + (y1 - y2)^(2::Int)+        closest r = checkBounds r (Rectangle x y w h)+++-- | First part of the algorithm:+-- Tries to find an area in which to place a new +-- rectangle so that it overlaps as little as possible with+-- other rectangles aready present. The first rectangles in+-- the list will be overlapped first.+findSpace :: Real a =>+             SmartRectangle a -- ^ The total available area+          -> [SmartRectangle a] -- ^ The parts aready in use+          -> a -- ^ Width of the rectangle to place+          -> a -- ^ Height of the rectangle to place+          -> [SmartRectangle a]+findSpace total [] _ _ = [total]+findSpace total rs@(_:rs') w h+  = case filter largeEnough $ cleanup $ substractRects total rs of+      [] -> findSpace total rs' w h+      as -> as+    where largeEnough r = width r >= w && height r >= h+++-- | Substracts smaller rectangles from a total rectangle+-- , returning a list of remaining rectangular areas.+substractRects :: Real a => SmartRectangle a +               -> [SmartRectangle a] -> [SmartRectangle a]+substractRects total [] = [total]+substractRects total (r:rs) +  = do total' <- substractRects total rs+       filter (not . isEmpty)+                [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above+                , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right+                , total' {sr_y0 = max (sr_y0 total') (sr_y1 r)} -- Below+                , total' {sr_x1 = min (sr_x1 total') (sr_x0 r)} -- Left+                ]+++-- | "Nubs" a list of rectangles, dropping all those that are+-- already contained in another rectangle of the list. +cleanup :: Real a => [SmartRectangle a] -> [SmartRectangle a]+cleanup rs = foldr dropIfContained [] $ sortBy sizeOrder rs++sizeOrder :: Real a => SmartRectangle a -> SmartRectangle a -> Ordering+sizeOrder r1 r2 | w1 < w2 = LT+                | w1 == w2 && h1 < h2 = LT+                | w1 == w2 && h1 == h2 = EQ+                | otherwise = GT+                where w1 = width r1+                      w2 = width r2+                      h1 = height r1+                      h2 = height r2++dropIfContained :: Real a => SmartRectangle a +                -> [SmartRectangle a] -> [SmartRectangle a]+dropIfContained r rs  = if any (`contains` r) rs+                        then rs+                        else r:rs
+ XMonad/Hooks/RestoreMinimized.hs view
@@ -0,0 +1,34 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.RestoreMinimized+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Hooks.RestoreMinimized+    ( RestoreMinimized (..)+    , restoreMinimizedEventHook+    ) where++import Data.Monoid+import Control.Monad(when)++import XMonad+import XMonad.Layout.Minimize++data RestoreMinimized = RestoreMinimized deriving ( Show, Read )++restoreMinimizedEventHook :: Event -> X All+restoreMinimizedEventHook (ClientMessageEvent {ev_window = w,+                                                ev_message_type = mt}) = do+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"+    a_cs <- getAtom "WM_CHANGE_STATE"+    when (mt == a_aw || mt == a_cs) $ do+        sendMessage (RestoreMinimizedWin w)+    return (All True)+restoreMinimizedEventHook _ = return (All True)
+ XMonad/Hooks/Script.hs view
@@ -0,0 +1,54 @@+-----------------------------------------------------------------------------+-- |+-- Module      : XMonad.Hooks.Script+-- Copyright   : (c) Trevor Elliott <trevor@galois.com>+-- License     : BSD3-style (see LICENSE)+--+-- Maintainer  : Trevor Elliott <trevor@galois.com>+-- Stability   : unstable+-- Portability : unportable+--+-- Provides a simple interface for running a ~\/.xmonad\/hooks script with the+-- name of a hook.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.Script (+    -- * Usage+    -- $usage++    -- * Script Hook Interface+    execScriptHook+  ) where++--+-- Useful Imports+--+import XMonad++import Control.Monad.Trans+import System.Directory++-- $usage+--+-- This module allows you to run a centrally located script with the text+-- name of a hook.  The script is assumed to be located at @~\/.xmonad\/hooks@.+--+-- For example, if you wanted to run the hook "startup" in your script every+-- time your startup hook ran, you could modify your xmonad config as such:+--+-- > main = xmonad $ defaultConfig {+-- >   ...+-- >   startupHook = execScriptHook "startup"+-- >   ...+-- >   }+--+-- Now, everytime the startup hook runs, the command+-- @~\/.xmonad\/hooks startup@ will also.++-- | Execute a named script hook+execScriptHook :: MonadIO m => String -> m ()+execScriptHook hook = io $ do+  home <- getHomeDirectory+  let script = home ++ "/.xmonad/hooks "+  spawn (script ++ hook)
+ XMonad/Hooks/ServerMode.hs view
@@ -0,0 +1,101 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.ServerMode+-- Copyright   :  (c) Andrea Rossato and David Roundy 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- This is an 'EventHook' that will receive commands from an external+-- client.+--+-- This is the example of a client:+--+-- > import Graphics.X11.Xlib+-- > import Graphics.X11.Xlib.Extras+-- > import System.Environment+-- > import Data.Char+-- >+-- > usage :: String -> String+-- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad"+-- >+-- > main :: IO ()+-- > main = do+-- >   args <- getArgs+-- >   pn <- getProgName+-- >   let com = case args of+-- >               [] -> error $ usage pn+-- >               w -> (w !! 0)+-- >   sendCommand com+-- >+-- > sendCommand :: String -> IO ()+-- > sendCommand s = do+-- >   d   <- openDisplay ""+-- >   rw  <- rootWindow d $ defaultScreen d+-- >   a <- internAtom d "XMONAD_COMMAND" False+-- >   allocaXEvent $ \e -> do+-- >                   setEventType e clientMessage+-- >                   setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime+-- >                   sendEvent d rw False structureNotifyMask e+-- >                   sync d False+--+-- compile with: @ghc --make sendCommand.hs@+--+-- run with+--+-- > sendCommand command number+--+-- For instance:+--+-- > sendCommand 0+--+--  will ask to xmonad to print the list of command numbers in+-- stderr (so you can read it in @~\/.xsession-errors@).+-----------------------------------------------------------------------------++module XMonad.Hooks.ServerMode+    ( -- * Usage+      -- $usage+      ServerMode (..)+    , serverModeEventHook+    , serverModeEventHookCustom+    ) where++import Control.Monad (when)+import Data.List+import Data.Monoid+import System.IO++import XMonad+import XMonad.Actions.Commands++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Hooks.ServerMode+--+-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':+--+-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }+--++data ServerMode = ServerMode deriving ( Show, Read )++serverModeEventHook :: Event -> X All+serverModeEventHook = serverModeEventHookCustom defaultCommands++serverModeEventHookCustom :: X [(String, X ())] -> Event -> X All+serverModeEventHookCustom commands (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do+        d <- asks display+        a <- io $ internAtom d "XMONAD_COMMAND" False+        when (mt == a && dt /= []) $ do+             cl <- commands+             let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)+             case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of+                  Just (_,action) -> action+                  Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl+        return (All True)+serverModeEventHookCustom _ _ = return (All True)
+ 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.+--+-- To your @~\/.xmonad\/xmonad.hs@ file, add the following line:+--+-- > import XMonad.Hooks.SetWMName+--+-- Then edit your @startupHook@:+--+-- > startupHook = setWMName "LG3D"+--+-- 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 hooks, see+-- "XMonad.Doc.Extending#4".+-----------------------------------------------------------------------------++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,438 @@+{-# 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++                                 -- ** Pop up a temporary dzen+                                 -- $temporary++                                 -- ** Highlight in existing dzen+                                 -- $existing++                                 -- ** Useful keybinding+                                 -- $keybinding++                                 -- ** Note+                                 -- $note++                                 -- * Troubleshooting+                                 -- $troubleshooting++                                 -- * Example: Setting up irssi + rxvt-unicode+                                 -- $example++                                 -- ** Configuring irssi+                                 -- $irssi++                                 -- ** Configuring screen+                                 -- $screen++                                 -- ** Configuring rxvt-unicode+                                 -- $urxvt++                                 -- ** Configuring xmonad+                                 -- $xmonad++                                 -- * Stuff for your config file:+                                 withUrgencyHook, withUrgencyHookC,+                                 UrgencyConfig(..), urgencyConfig,+                                 SuppressWhen(..), RemindWhen(..),+                                 focusUrgent, clearUrgents,+                                 dzenUrgencyHook,+                                 DzenUrgencyHook(..),+                                 NoUrgencyHook(..),+                                 FocusHook(..),+                                 minutes, seconds,+                                 -- * Stuff for developers:+                                 readUrgents, withUrgents,+                                 StdoutUrgencyHook(..),+                                 SpawnUrgencyHook(..),+                                 UrgencyHook(urgencyHook)+                                 ) where++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Util.Dzen (dzenWithArgs, seconds)+import XMonad.Util.NamedWindows (getName)+import XMonad.Util.Timer (TimerId, startTimer, handleTimer)++import Control.Applicative ((<$>))+import Control.Monad (when)+import Data.Bits (testBit)+import Data.IORef+import Data.List (delete)+import Data.Maybe (listToMaybe, maybeToList)+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, you have a decision to make:+-- When a window deems itself urgent, do you want to pop up a temporary dzen+-- bar telling you so, or do you have an existing dzen wherein you would like to+-- highlight urgent workspaces?++-- $temporary+--+-- 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+--+-- This will pop up a dzen bar for five seconds telling you you've got an+-- urgent window.++-- $existing+--+-- In order for xmonad to track urgent windows, you must install an urgency hook.+-- You can use the above 'dzenUrgencyHook', or if you're not interested in the+-- extra popup, install NoUrgencyHook, as so:+--+-- > main = xmonad $ withUrgencyHook NoUrgencyHook+-- >               $ defaultConfig+--+-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent+-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,+-- then you should be good. Otherwise, you want to figure out how to set+-- 'ppUrgent'.++-- $keybinding+--+-- You can set up a keybinding to jump to the window that was recently marked+-- urgent. See an example at 'focusUrgent'.++-- $note+-- Note: UrgencyHook installs itself as a LayoutModifier, so if you modify your+-- urgency hook and restart xmonad, you may need to rejigger your layout by+-- hitting mod-shift-space.++-- $troubleshooting+--+-- There are three steps to get right:+--+-- 1. The X client must set the UrgencyHint flag. How to configure this+--    depends on the application. If you're using a terminal app, this is in+--    two parts:+--+--      * The console app must send a ^G (bell). In bash, a helpful trick is+--        @sleep 1; echo -e \'\a\'@.+--+--      * The terminal must convert the bell into UrgencyHint.+--+-- 2. XMonad must be configured to notice UrgencyHints. If you've added+--    withUrgencyHook, you may need to hit mod-shift-space to reset the layout.+--+-- 3. The dzen must run when told. Run @dzen2 -help@ and make sure that it+--    supports all of the arguments you told DzenUrgencyHook to pass it. Also,+--    set up a keybinding to the 'dzen' action in "XMonad.Util.Dzen" to test+--    if that works.+--+-- As best you can, try to isolate which one(s) of those is failing.++-- $example+--+-- This is a commonly asked example. By default, the window doesn't get flagged+-- urgent when somebody messages you in irssi. You will have to configure some+-- things. If you're using different tools than this, your mileage will almost+-- certainly vary. (For example, in Xchat2, it's just a simple checkbox.)++-- $irssi+-- @Irssi@ is not an X11 app, so it can't set the @UrgencyHint@ flag on @XWMHints@.+-- However, on all console applications is bestown the greatest of all notification+-- systems: the bell. That's right, Ctrl+G, ASCII code 7, @echo -e '\a'@, your+-- friend, the bell. To configure @irssi@ to send a bell when you receive a message:+--+-- > /set beep_msg_level MSGS NOTICES INVITES DCC DCCMSGS HILIGHT+--+-- Consult your local @irssi@ documentation for more detail.++-- $screen+-- A common way to run @irssi@ is within the lovable giant, @screen@. Some distros+-- (e.g. Ubuntu) like to configure @screen@ to trample on your poor console+-- applications -- in particular, to turn bell characters into evil, smelly+-- \"visual bells.\" To turn this off, add:+--+-- > vbell off # or remove the existing 'vbell on' line+--+-- to your .screenrc, or hit @C-a C-g@ within a running @screen@ session for an+-- immediate but temporary fix.++-- $urxvt+-- Rubber, meet road. Urxvt is the gateway between console apps and X11. To tell+-- urxvt to set an @UrgencyHint@ when it receives a bell character, first, have+-- an urxvt version 8.3 or newer, and second, set the following in your+-- @.Xdefaults@:+--+-- > urxvt.urgentOnBell: true+--+-- Depending on your setup, you may need to @xrdb@ that.++-- $xmonad+-- Hopefully you already read the section on how to configure xmonad. If not,+-- hopefully you know where to find it.++-- | This is the method to enable an urgency hook. It uses the default+-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'+-- instead.+withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>+                   h -> XConfig l -> XConfig l+withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf++-- | This lets you modify the defaults set in 'urgencyConfig'. An example:+--+-- > withUrgencyHookC dzenUrgencyHook { ... } urgencyConfig { suppressWhen = Focused }+--+-- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.+withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>+                    h -> UrgencyConfig -> XConfig l -> XConfig l+withUrgencyHookC hook urgConf conf = conf {+        handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,+        logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf+    }++-- | Global configuration, applied to all types of 'UrgencyHook'. See+-- 'urgencyConfig' for the defaults.+data UrgencyConfig = UrgencyConfig+    { suppressWhen :: SuppressWhen -- ^ when to trigger the urgency hook+    , remindWhen   :: RemindWhen   -- ^ when to re-trigger the urgency hook+    } deriving (Read, Show)++-- | A set of choices as to /when/ you should (or rather, shouldn't) be notified of an urgent window.+-- The default is 'Visible'. Prefix each of the following with \"don't bug me when\":+data SuppressWhen = Visible  -- ^ the window is currently visible+                  | OnScreen -- ^ the window is on the currently focused physical screen+                  | Focused  -- ^ the window is currently focused+                  | Never    -- ^ ... aww, heck, go ahead and bug me, just in case.+                  deriving (Read, Show)++-- | A set of choices as to when you want to be re-notified of an urgent+-- window. Perhaps you focused on something and you miss the dzen popup bar. Or+-- you're AFK. Or you feel the need to be more distracted. I don't care.+--+-- The interval arguments are in seconds. See the 'minutes' helper.+data RemindWhen = Dont                    -- ^ triggering once is enough+                | Repeatedly Int Interval -- ^ repeat <arg1> times every <arg2> seconds+                | Every Interval          -- ^ repeat every <arg1> until the urgency hint is cleared+                deriving (Read, Show)++-- | A prettified way of multiplying by 60. Use like: @(5 `minutes`)@.+minutes :: Rational -> Rational+minutes secs = secs * 60++-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.+-- Use a variation of this in your config just as you use a variation of+-- defaultConfig for your xmonad definition.+urgencyConfig :: UrgencyConfig+urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }++-- | 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++-- | Just makes the urgents go away.+-- Example keybinding:+--+-- > , ((modMask .|. shiftMask, xK_BackSpace), clearUrgents)+clearUrgents :: X ()+clearUrgents = adjustUrgents (const []) >> adjustReminders (const [])++-- | 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++adjustUrgents :: ([Window] -> [Window]) -> X ()+adjustUrgents f = io $ modifyIORef urgents f++type Interval = Rational++-- | An urgency reminder, as reified for 'RemindWhen'.+-- The last value is the countdown number, for 'Repeatedly'.+data Reminder = Reminder { timer     :: TimerId+                         , window    :: Window+                         , interval  :: Interval+                         , remaining :: Maybe Int+                         } deriving Eq++-- | Stores the list of urgency reminders.+{-# NOINLINE reminders #-}+reminders :: IORef [Reminder]+reminders = unsafePerformIO (newIORef [])++readReminders :: X [Reminder]+readReminders = io $ readIORef reminders++adjustReminders :: ([Reminder] -> [Reminder]) -> X ()+adjustReminders f = io $ modifyIORef reminders f++clearUrgency :: Window -> X ()+clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)++data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig+    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. 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.+--   2. 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 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!+handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()+handleEvent wuh event =+    case event of+      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do+          when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do+              WMHints { wmh_flags = flags } <- io $ getWMHints dpy w+              if (testBit flags urgencyHintBit) then do+                  adjustUrgents (\ws -> if elem w ws then ws else w : ws)+                  callUrgencyHook wuh w+                else+                  clearUrgency w+              userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified+      DestroyWindowEvent {ev_window = w} ->+          clearUrgency w+      _ ->+          mapM_ handleReminder =<< readReminders+      where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder++callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()+callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =+    whenX (not <$> shouldSuppress sw w) $ do+        userCodeDef () $ urgencyHook hook w+        case rw of+            Repeatedly times int -> addReminder w int $ Just times+            Every int            -> addReminder w int Nothing+            Dont                 -> return ()++addReminder :: Window -> Rational -> Maybe Int -> X ()+addReminder w int times = do+    timerId <- startTimer int+    let reminder = Reminder timerId w int times+    adjustReminders (\rs -> if w `elem` map window rs then rs else reminder : rs)++reminderHook :: UrgencyHook h => WithUrgencyHook h -> Reminder -> X (Maybe a)+reminderHook (WithUrgencyHook hook _) reminder = do+    case remaining reminder of+        Just x | x > 0 -> remind $ Just (x - 1)+        Just _         -> adjustReminders $ delete reminder+        Nothing        -> remind Nothing+    return Nothing+  where remind remaining' = do userCode $ urgencyHook hook (window reminder)+                               adjustReminders $ delete reminder+                               addReminder (window reminder) (interval reminder) remaining'++shouldSuppress :: SuppressWhen -> Window -> X Bool+shouldSuppress sw w = elem w <$> suppressibleWindows sw++cleanupUrgents :: SuppressWhen -> X ()+cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw++suppressibleWindows :: SuppressWhen -> X [Window]+suppressibleWindows Visible  = gets $ S.toList . mapped+suppressibleWindows OnScreen = gets $ W.index . windowset+suppressibleWindows Focused  = gets $ maybeToList . W.peek . windowset+suppressibleWindows Never    = return []++--------------------------------------------------------------------------------+-- Urgency Hooks++-- | The class definition, and some pre-defined instances.++class (Read h, Show h) => UrgencyHook h where+    urgencyHook :: h -> Window -> X ()++data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)++instance UrgencyHook NoUrgencyHook where+    urgencyHook _ _ = return ()++-- | Your set of options for configuring a dzenUrgencyHook.+data DzenUrgencyHook = DzenUrgencyHook {+                         duration :: Int, -- ^ number of microseconds to display the dzen+                                          --   (hence, you'll probably want to use 'seconds')+                         args :: [String] -- ^ list of extra args (as 'String's) to pass to dzen+                       }+    deriving (Read, Show)++instance UrgencyHook DzenUrgencyHook where+    urgencyHook DzenUrgencyHook { duration = d, args = a } w = do+        name <- getName w+        ws <- gets windowset+        whenJust (W.findTag w ws) (flash name)+      where flash name index =+                  dzenWithArgs (show name ++ " requests your attention on workspace " ++ index) a d++{- | A hook which will automatically send you to anything which sets the urgent+  flag (as opposed to printing some sort of message. You would use this as+  usual, eg.++  > withUrgencyHook FocusHook $ myconfig { ...+-}+data FocusHook = FocusHook deriving (Read, Show)++instance UrgencyHook FocusHook where+    urgencyHook _ _ = focusUrgent++-- | Flashes when a window requests your attention and you can't see it.+-- Defaults to a duration of five seconds, and no extra args to dzen.+-- See 'DzenUrgencyHook'.+dzenUrgencyHook :: DzenUrgencyHook+dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }++-- | Spawn a commandline thing, appending the window id to the prefix string+-- you provide. (Make sure to add a space if you need it.) Do your crazy+-- xcompmgr thing.+newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)++instance UrgencyHook SpawnUrgencyHook where+    urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w++-- | For debugging purposes, really.+data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)++instance UrgencyHook StdoutUrgencyHook where+    urgencyHook    _ w = io $ putStrLn $ "Urgent: " ++ show w
+ XMonad/Hooks/WorkspaceByPos.hs view
@@ -0,0 +1,50 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.WorkspaceByPos+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Hooks.WorkspaceByPos (+    workspaceByPos+    ) where++import XMonad+import qualified XMonad.StackSet as W++import Data.Maybe+import Control.Applicative((<$>))++workspaceByPos :: ManageHook+workspaceByPos = ask >>= \w -> do+                    b <- liftX $ needsMoving w+                    case b of+                        Nothing       -> idHook+                        Just wkspc    -> doShift wkspc++needsMoving :: Window -> X (Maybe WorkspaceId)+needsMoving w = withDisplay $ \d -> do+                    -- only relocate windows with non-zero position+                    wa <- io $ getWindowAttributes d w+                    if ((wa_x wa) == 0) && ((wa_y wa) == 0)+                        then return Nothing+                        else do+                            ws <- gets windowset+                            sc <- fromMaybe (W.current ws)+                                    <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)+                            maybeWkspc <- screenWorkspace (W.screen sc)+                            case maybeWkspc of+                                Nothing -> return Nothing+                                Just wkspc -> do+                                    let currentWksp = W.currentTag ws+                                    if currentWksp == wkspc+                                        then return Nothing+                                        else return (Just wkspc)++fi ::  (Integral a, Num b) => a -> b+fi = fromIntegral
+ 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/BorderResize.hs view
@@ -0,0 +1,145 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.BorderResize+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.BorderResize+    ( borderResize+    , BorderResize (..)+    ) where++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.WindowArranger+import XMonad.Util.XUtils+import Control.Monad(when)++data BorderInfo = RightSideBorder Window Rectangle+                    | LeftSideBorder Window Rectangle+                    | TopSideBorder Window Rectangle+                    | BottomSideBorder Window Rectangle+                    deriving (Show, Read, Eq)+type BorderWithRect = (Rectangle, Rectangle, Glyph, BorderInfo)+type BorderWithWin = (Window, BorderInfo)++data BorderResize a = BR [BorderWithWin] deriving (Show, Read)++brBorderOffset :: Position+brBorderOffset = 5+brBorderSize :: Dimension+brBorderSize = 10++brCursorRightSide :: Glyph+brCursorRightSide = 96+brCursorLeftSide :: Glyph+brCursorLeftSide = 70+brCursorTopSide :: Glyph+brCursorTopSide = 138+brCursorBottomSide :: Glyph+brCursorBottomSide = 16++borderResize :: l a -> ModifiedLayout BorderResize l a+borderResize = ModifiedLayout (BR [])++instance LayoutModifier BorderResize Window where+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)+    redoLayout (BR borders) _ _ wrs =+        let preparedBorders = concat $ map prepareBorders wrs+            visibleBorders = selectVisible [] preparedBorders+        in do+            mapM_ deleteBorder borders+            newBorders <- mapM createBorder visibleBorders+            return (wrs, Just $ BR newBorders)++    handleMess (BR borders) m+        | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ BR [])+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ BR [])+        where releaseResources = mapM_ deleteBorder borders+    handleMess _ _ = return Nothing++prepareBorders :: (Window, Rectangle) -> [BorderWithRect]+prepareBorders (w, r@(Rectangle x y wh ht)) =+    [(r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide     , RightSideBorder w r),+     (r, (Rectangle (x - brBorderOffset) y brBorderSize ht)         , brCursorLeftSide      , LeftSideBorder w r),+     (r, (Rectangle x (y - brBorderOffset) wh brBorderSize)         , brCursorTopSide       , TopSideBorder w r),+     (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide    , BottomSideBorder w r)+    ]++selectVisible :: [Rectangle] -> [BorderWithRect] -> [BorderWithRect]+selectVisible _ [] = []+selectVisible rs (border@(hostRect, borderRect, _, _) : borders)+        | borderRect `isVisible` otherRs    = border : selectVisible (hostRect : borderRect : rs) borders+        | otherwise                         = selectVisible (hostRect : rs) borders+    where+        otherRs = filter (/= hostRect) rs++handleResize :: [BorderWithWin] -> Event -> X ()+handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }+    | et == buttonPress = do+        case (lookup ew borders) of+            Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do+                focus hostWin+                mouseDrag (\x _ -> do+                             let nwh = max 1 $ fi (x - hx)+                                 rect = Rectangle hx hy nwh hht+                             when (x - hx > 0) $ sendMessage (SetGeometry rect)) (return ())+            Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do+                focus hostWin+                mouseDrag (\x _ -> do+                             let nx = max 0 $ min (hx + fi hwh) $ x+                                 nwh = max 1 $ hwh + fi (hx - x)+                                 rect = Rectangle nx hy nwh hht+                             when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (return ())+            Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do+                focus hostWin+                mouseDrag (\_ y -> do+                             let ny = max 0 $ min (hy + fi hht) $ y+                                 nht = max 1 $ hht + fi (hy - y)+                                 rect = Rectangle hx ny hwh nht+                             when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (return ())+            Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do+                focus hostWin+                mouseDrag (\_ y -> do+                             let nht = max 1 $ fi (y - hy)+                                 rect = Rectangle hx hy hwh nht+                             when (y - hy > 0) $ sendMessage (SetGeometry rect)) (return ())+            Nothing -> return ()+handleResize _ _ = return ()++createBorder :: BorderWithRect -> X (BorderWithWin)+createBorder (_, borderRect, borderCursor, borderInfo) = do+    borderWin <- createInputWindow borderCursor borderRect+    return (borderWin, borderInfo)++deleteBorder :: BorderWithWin -> X ()+deleteBorder (borderWin, _) = deleteWindow borderWin++createInputWindow :: Glyph -> Rectangle -> X Window+createInputWindow cursorGlyph r = withDisplay $ \d -> do+    win <- mkInputWindow d r+    io $ selectInput d win (exposureMask .|. buttonPressMask)+    cursor <- io $ createFontCursor d cursorGlyph+    io $ defineCursor d win cursor+    io $ freeCursor d cursor+    showWindow win+    return win++mkInputWindow :: Display -> Rectangle -> X Window+mkInputWindow d (Rectangle x y w h) = do+  rw <- asks theRoot+  let screen   = defaultScreenOfDisplay d+      visual   = defaultVisualOfScreen screen+      attrmask = cWOverrideRedirect+  io $ allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes True+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
+ XMonad/Layout/BoringWindows.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.BoringWindows+-- Copyright   :  (c) 2008  David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- Stability   :  unstable+-- Portability :  unportable+--+-- BoringWindows is an extension to allow windows to be marked boring+--+-----------------------------------------------------------------------------++module XMonad.Layout.BoringWindows (+                                   -- * Usage+                                   -- $usage+                                   boringWindows, boringAuto,+                                   markBoring, clearBoring,+                                   focusUp, focusDown,++                                   UpdateBoring(UpdateBoring),+                                   BoringMessage(Replace,Merge),+                                   BoringWindows()+                                  ) where++import XMonad.Layout.LayoutModifier(ModifiedLayout(..),+                                    LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))+import XMonad(Typeable, LayoutClass, Message, X, fromMessage,+              sendMessage, windows, withFocused, Window)+import Control.Applicative((<$>))+import Control.Monad(Monad(return, (>>)))+import Data.List((\\), union)+import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,+                  maybeToList)+import qualified Data.Map as M+import qualified XMonad.StackSet as W++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.BoringWindows+--+-- Then edit your @layoutHook@ by adding the layout modifier:+--+-- > myLayouts = boringWindows (Full ||| etc..)+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- Then to your keybindings, add:+--+-- > , ((modMask, xK_j), focusUp)+-- > , ((modMask, xk_k), focusDown)+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+++data BoringMessage = FocusUp | FocusDown | IsBoring Window | ClearBoring+                     | Replace String [Window]+                     | Merge String [Window]+                     deriving ( Read, Show, Typeable )++instance Message BoringMessage++-- | UpdateBoring is sent before attempting to view another boring window, so+-- that layouts have a chance to mark boring windows.+data UpdateBoring = UpdateBoring+    deriving (Typeable)+instance Message UpdateBoring++markBoring, clearBoring, focusUp, focusDown :: X ()+markBoring = withFocused (sendMessage . IsBoring)+clearBoring = sendMessage ClearBoring+focusUp = sendMessage UpdateBoring >> sendMessage FocusUp+focusDown = sendMessage UpdateBoring >> sendMessage FocusDown++data BoringWindows a = BoringWindows+    { namedBoring :: M.Map String [a] -- ^ store borings with a specific source+    , chosenBoring :: [a]             -- ^ user-chosen borings+    , hiddenBoring :: Maybe [a]       -- ^ maybe mark hidden windows+    } deriving (Show,Read,Typeable)++boringWindows :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a+boringWindows = ModifiedLayout (BoringWindows M.empty [] Nothing)++-- | Mark windows that are not given rectangles as boring+boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a+boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))++instance LayoutModifier BoringWindows Window where+    redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do+        let bs' = W.integrate' mst \\ map fst arrs+        return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )++    handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m+        | Just (Replace k ws) <- fromMessage m+        , maybe True (ws/=) (M.lookup k nbs) =+            let nnb = if null ws then M.delete k nbs+                          else M.insert k ws nbs+            in rjl bst { namedBoring = nnb }+        | Just (Merge k ws) <- fromMessage m+        , maybe True (not . null . (ws \\)) (M.lookup k nbs) =+            rjl bst { namedBoring = M.insertWith union k ws nbs }+        | Just (IsBoring w) <- fromMessage m , w `notElem` cbs =+            rjl bst { chosenBoring = w:cbs }+        | Just ClearBoring <- fromMessage m, not (null cbs) =+            rjl bst { namedBoring = M.empty, chosenBoring = []}+        | Just FocusUp <- fromMessage m =+                            do windows $ W.modify' $ skipBoring W.focusUp'+                               return Nothing+        | Just FocusDown <- fromMessage m =+                            do windows $ W.modify' $ skipBoring W.focusDown'+                               return Nothing+        where skipBoring f st = fromMaybe st $ listToMaybe+                                $ filter ((`notElem` W.focus st:bs) . W.focus)+                                $ take (length $ W.integrate st)+                                $ iterate f st+              bs = concat $ cbs:maybeToList lbs ++ M.elems nbs+              rjl = return . Just . Left+    handleMessOrMaybeModifyIt _ _ = return Nothing
+ XMonad/Layout/CenteredMaster.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.CenteredMaster+-- Copyright   :  (c) 2009 Ilya Portnov+-- License     :  GNU GPL v3 or any later+--+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Two layout modifiers. centerMaster places master window at center, +-- on top of all other windows, which are managed by base layout. +-- topRightMaster is similar, but places master window in top right corner +-- instead of center.+--+-----------------------------------------------------------------------------++module XMonad.Layout.CenteredMaster (+         -- * Usage+         -- $usage++         centerMaster,+         topRightMaster+         ) where++import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.StackSet as W++-- $usage+-- This module defines two new layout modifiers: centerMaster and topRightMaster.+-- centerMaster places master window at center of screen, on top of others. +-- All other windows in background are managed by base layout.+-- topRightMaster is like centerMaster, but places master window in top right corner instead of center.+-- +-- Yo can use this module by adding folowing in your @xmonad.hs@:+--+-- > import XMonad.Layout.CenteredMaster+-- +-- Then add layouts to your layoutHook:+-- +-- > myLayoutHook = centerMaster Grid ||| ...++-- | Function that decides where master window should be placed+type Positioner = Rectangle -> Rectangle++-- | Data type for LayoutModifier +data CenteredMaster a = CenteredMaster deriving (Read,Show)++instance LayoutModifier CenteredMaster Window where+  modifyLayout CenteredMaster = applyPosition (center (5/7) (5/7))++data TopRightMaster a = TopRightMaster deriving (Read,Show)++instance LayoutModifier TopRightMaster Window where+  modifyLayout TopRightMaster = applyPosition (topRight (3/7) (1/2))++-- | Modifier that puts master window in center, other windows in background +-- are managed by given layout+centerMaster :: LayoutClass l a => l a -> ModifiedLayout CenteredMaster l a+centerMaster = ModifiedLayout CenteredMaster++-- | Modifier that puts master window in top right corner, other windows in background +-- are managed by given layout+topRightMaster :: LayoutClass l a => l a -> ModifiedLayout TopRightMaster l a+topRightMaster = ModifiedLayout TopRightMaster++-- | Internal function, doing main job+applyPosition :: (LayoutClass l a, Eq a) =>+                    Positioner+                 -> W.Workspace WorkspaceId (l a) a+                 -> Rectangle+                 -> X ([(a, Rectangle)], Maybe (l a))++applyPosition pos wksp rect = do+  let stack = W.stack wksp+  let ws = W.integrate' $ stack+  if null ws then+     runLayout wksp rect+     else do+       let first = head ws+       let other = tail ws+       let filtStack = stack >>= W.filter (first /=)+       wrs <- runLayout (wksp {W.stack = filtStack}) rect+       return ((first, place pos other rect) : fst wrs, snd wrs)++-- | Place master window (it's Rectangle is given), using the given Positioner.+-- If second argument is empty (that is, there is only one window on workspace),+-- place that window fullscreen.+place :: Positioner -> [a] -> Rectangle -> Rectangle+place _ [] rect = rect+place pos _ rect = pos rect++-- | Function that calculates Rectangle at top right corner of given Rectangle+topRight :: Float -> Float -> Rectangle -> Rectangle+topRight rx ry (Rectangle sx sy sw sh) = Rectangle x sy w h+  where w = round (fromIntegral sw * rx)+        h = round (fromIntegral sh * ry)+        x = sx + fromIntegral (sw-w)++-- | Function that calculates Rectangle at center of given Rectangle.+center :: Float -> Float -> Rectangle -> Rectangle+center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h+  where w = round (fromIntegral sw * rx)+        h = round (fromIntegral sh * ry)+        x = sx + fromIntegral (sw-w) `div` 2+        y = sy + fromIntegral (sh-h) `div` 2++
+ 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,144 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,+             UndecidableInstances, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Combo+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  none+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout that combines multiple layouts.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Combo (+                            -- * Usage+                            -- $usage+                            combineTwo,+                            CombineTwo+                           ) where++import Data.List ( delete, intersect, (\\) )+import Data.Maybe ( isJust )+import XMonad hiding (focus)+import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )+import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )+import qualified XMonad.StackSet as W ( differentiate )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Combo+--+-- and add something like+--+-- > combineTwo (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf)+--+-- to your layouts.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- combineTwo is a new simple layout combinator. It allows the+-- combination of two layouts using a third to split the screen+-- between the two, but has the advantage of allowing you to+-- dynamically adjust the layout, in terms of the number of windows in+-- each sublayout. To do this, use "XMonad.Layout.WindowNavigation",+-- and add the following key bindings (or something similar):+--+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage $ Move R)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage $ Move L)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage $ Move U)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage $ Move D)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".+--+-- These bindings will move a window into the sublayout that is+-- up\/down\/left\/right of its current position.  Note that there is some+-- weirdness in combineTwo, in that the mod-tab focus order is not very closely+-- related to the layout order. This is because we're forced to keep track of+-- the window positions separately, and this is ugly.  If you don't like this,+-- lobby for hierarchical stacks in core xmonad or go reimplement the core of+-- xmonad yourself.++data CombineTwo l l1 l2 a = C2 [a] [a] l (l1 a) (l2 a)+                            deriving (Read, Show)++combineTwo :: (Read a, Eq a, LayoutClass super (), LayoutClass l1 a, LayoutClass l2 a) =>+              super () -> l1 a -> l2 a -> CombineTwo (super ()) l1 l2 a+combineTwo = C2 [] []++instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)+    => LayoutClass (CombineTwo (l ()) l1 l2) a where+    runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = 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 = Stack { focus=(), up=[], down=[()] }+                         s1 = differentiate f' (origws \\ w2')+                         s2 = differentiate f' w2'+                         f' = case s of (Just s') -> focus s':delete (focus s') f+                                        Nothing -> f+                     ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super (Just superstack)) rinput+                     (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1+                     (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2+                     return (wrs1++wrs2, Just $ C2 f' w2'+                                     (maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))+    handleMessage (C2 f ws2 super l1 l2) m+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `notElem` ws2,+          w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m+                             l2' <- maybe l2 id `fmap` handleMessage l2 m+                             return $ Just $ C2 f (w1:ws2) super l1' l2'+        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `elem` ws2,+          w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m+                                l2' <- maybe l2 id `fmap` handleMessage l2 m+                                let ws2' = case delete w1 ws2 of [] -> [w2]+                                                                 x -> x+                                return $ Just $ C2 f ws2' super l1' l2'+        | otherwise = do ml1' <- broadcastPrivate m [l1]+                         ml2' <- broadcastPrivate m [l2]+                         msuper' <- broadcastPrivate m [super]+                         if isJust msuper' || isJust ml1' || isJust ml2'+                            then return $ Just $ C2 f ws2+                                                 (maybe super head msuper')+                                                 (maybe l1 head ml1')+                                                 (maybe l2 head ml2')+                            else return Nothing+    description (C2 _ _ super l1 l2) = "combining "++ description l1 ++" and "+++                                       description l2 ++" with "++ description super+++differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)+differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z+                                                     , up = reverse $ takeWhile (/=z) xs+                                                     , down = tail $ dropWhile (/=z) xs }+                        | otherwise = differentiate zs xs+differentiate [] xs = W.differentiate xs++broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])+broadcastPrivate a ol = do nml <- mapM f ol+                           if any isJust nml+                              then return $ Just $ zipWith ((flip maybe) id) ol nml+                              else return Nothing+    where f l = handleMessage l a `catchX` return Nothing
+ XMonad/Layout/ComboP.hs view
@@ -0,0 +1,180 @@+{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ComboP+-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout that combines multiple layouts and allows to specify where to put+-- new windows.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ComboP (+                             -- * Usage+                             -- $usage+                             combineTwoP,+                             CombineTwoP,+                             SwapWindow(..),+                             Property(..)+                            ) where++import Data.List ( delete, intersect, (\\) )+import Data.Maybe ( isJust )+import Control.Monad+import XMonad hiding (focus)+import XMonad.StackSet ( integrate, Workspace (..), Stack(..) )+import XMonad.Layout.WindowNavigation+import XMonad.Util.WindowProperties+import qualified XMonad.StackSet as W++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ComboP+--+-- and add something like+--+-- > combineTwoP (TwoPane 0.03 0.5) (tabbed shrinkText defaultTConf) (tabbed shrinkText defaultTConf) (ClassName "Firefox")+--+-- to your layouts. This way all windows with class = \"Firefox\" will always go+-- to the left pane, all others - to the right.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- 'combineTwoP' is a simple layout combinator based on 'combineTwo' from Combo, with+-- addition of a 'Property' which tells where to put new windows. Windows mathing+-- the property will go into the first part, all others will go into the second+-- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces+-- 'SwapWindow' message which sends focused window to the other part. It is+-- required becase @Move@ commands don't work when one of the parts is empty.+-- To use it, import \"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)+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_s    ), sendMessage $ SwapWindow)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data SwapWindow =  SwapWindow        -- ^ Swap window between panes+                 | SwapWindowN Int   -- ^ Swap window between panes in the N-th nested ComboP. @SwapWindowN 0@ equals to SwapWindow+                 deriving (Read, Show, Typeable)+instance Message SwapWindow++data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property+                                deriving (Read, Show)++combineTwoP :: (LayoutClass super(), LayoutClass l1 Window, LayoutClass l2 Window) =>+                super () -> l1 Window -> l2 Window -> Property -> CombineTwoP (super ()) l1 l2 Window+combineTwoP = C2P [] [] []++instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>+    LayoutClass (CombineTwoP (l ()) l1 l2) Window where+    doLayout (C2P f w1 w2 super l1 l2 prop) rinput s =+        let origws = W.integrate s           -- passed in windows+            w1c = origws `intersect` w1      -- current windows in the first pane+            w2c = origws `intersect` w2      -- current windows in the second pane+            new = origws \\ (w1c ++ w2c)     -- new windows+            superstack = Just Stack { focus=(), up=[], down=[()] }+            f' = focus s:delete (focus s) f  -- list of focused windows, contains 2 elements at most+        in do+            matching <- (hasProperty prop) `filterM` new  -- new windows matching predecate+            let w1' = w1c ++ matching                     -- updated first pane windows+                w2' = w2c ++ (new \\ matching)            -- updated second pane windows+                s1 = differentiate f' w1'                 -- first pane stack+                s2 = differentiate f' w2'                 -- second pane stack+            ([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput+            (wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1+            (wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2+            return  (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')+                (maybe l1 id ml1') (maybe l2 id ml2') prop)++    handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m+        | Just SwapWindow      <- fromMessage m = swap us+        | Just (SwapWindowN 0) <- fromMessage m = swap us+        | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1++        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `elem` ws1,+          w2 `elem` ws2 = return $ Just $ C2P f (delete w1 ws1) (w1:ws2) super l1 l2 prop++        | Just (MoveWindowToWindow w1 w2) <- fromMessage m,+          w1 `elem` ws2,+          w2 `elem` ws1 = return $ Just $ C2P f (w1:ws1) (delete w1 ws2) super l1 l2 prop++        | otherwise = do ml1' <- handleMessage l1 m+                         ml2' <- handleMessage l2 m+                         msuper' <- handleMessage super m+                         if isJust msuper' || isJust ml1' || isJust ml2'+                            then return $ Just $ C2P f ws1 ws2+                                                 (maybe super id msuper')+                                                 (maybe l1 id ml1')+                                                 (maybe l2 id ml2') prop+                            else return Nothing++    description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "+++                                description l2 ++ " with " ++ description super ++ " using "++ (show prop)++-- send focused window to the other pane. Does nothing if we don't+-- own the focused window+swap :: (LayoutClass s a, LayoutClass l1 Window, LayoutClass l2 Window) =>+        CombineTwoP (s a) l1 l2 Window -> X (Maybe (CombineTwoP (s a) l1 l2 Window))+swap (C2P f ws1 ws2 super l1 l2 prop) = do+    mst <- gets (W.stack . W.workspace . W.current . windowset)+    let (ws1', ws2') = case mst of+            Nothing -> (ws1, ws2)+            Just st -> if foc `elem` ws1+                           then (foc `delete` ws1, foc:ws2)+                           else if foc `elem` ws2+                               then (foc:ws1, foc `delete` ws2)+                               else (ws1, ws2)+                       where foc = W.focus st+    if (ws1,ws2) == (ws1',ws2')+        then return Nothing+        else return $ Just $ C2P f ws1' ws2' super l1 l2 prop+++-- forwards the message to the sublayout which contains the focused window+forwardToFocused :: (LayoutClass l1 Window, LayoutClass l2 Window, LayoutClass s a) =>+                    CombineTwoP (s a) l1 l2 Window -> SomeMessage -> X (Maybe (CombineTwoP (s a) l1 l2 Window))+forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do+    ml1 <- forwardIfFocused l1 ws1 m+    ml2 <- forwardIfFocused l2 ws2 m+    ms <- if isJust ml1 || isJust ml2+            then return Nothing+            else handleMessage super m+    if isJust ml1 || isJust ml2 || isJust ms+        then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop+        else return Nothing++-- forwards message m to layout l if focused window is among w+forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessage -> X (Maybe (l Window))+forwardIfFocused l w m = do+    mst <- gets (W.stack . W.workspace . W.current . windowset)+    maybe (return Nothing) send mst where+    send st = if (W.focus st) `elem` w+                then handleMessage l m+                else return Nothing++-- code from CombineTwo+-- given two sets of zs and xs takes the first z from zs that also belongs to xs+-- and turns xs into a stack with z being current element. Acts as+-- StackSet.differentiate if zs and xs don't intersect+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++-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
+ XMonad/Layout/Cross.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-- |+-- Module      :  XMonad.Layout.Cross+-- Copyright   :  (c) Luis Cabellos <zhen.sydow@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Luis Cabellos <zhen.sydow@gmail.com>+-- Stability   :  stable+-- Portability :  portable+--+-- A Cross Layout with the main window in the center.+--+module XMonad.Layout.Cross(+                          -- * Usage+                          -- $usage+                          simpleCross+                          , Cross(..) ) where++import XMonad( Dimension, Rectangle(..), LayoutClass(..), Resize(..), fromMessage )+import XMonad.StackSet( focus, up, down )+import Control.Monad( msum )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Cross+--+-- Then edit your @layoutHook@ by adding one of the Cross layouts:+--+-- > myLayouts =  simpleCross ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--++-- apply a factor to a Rectangle Dimension+(<%>) :: Dimension -> Rational -> Dimension+d <%> f = floor $ f * (fromIntegral d)++-- | The Cross Layout draws the focused window in the center of the screen+--   and part of the other windows on the sides. The 'Shrink' and 'Expand'+--   messages increment the size of the main window.+--+--   The focus keybindings change the center window, while other windows+--   cycle through the side positions. With the Cross layout only four+--   windows are shown around the focused window, two ups and two downs,+--   no matter how many are in the current stack. I.e. focus down cycles the+--   window below focused into the center; focus up cycles the window above.+data Cross a = Cross {+      crossProp :: !Rational, -- ^ Proportion of screen occupied by the main window.+      crossInc  :: !Rational  -- ^ Percent of main window to increment by when resizing.+    }+    deriving( Show, Read )++-- | A simple Cross Layout. It places the focused window in the center.+--   The proportion of the screen used by the main window is 4\/5.+simpleCross :: Cross a+simpleCross = Cross (4/5) (1/100)++instance LayoutClass Cross a where+    pureLayout (Cross f _) r s = [(focus s, mainRect r f)] +++                                 (zip winCycle (upRects r f)) +++                                 (zip (reverse winCycle) (downRects r f))+        where winCycle = (up s) ++ (reverse (down s))++    pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]+        where resize Shrink = Cross (max (1/100) $ f - d) d+              resize Expand = Cross (min 1 $ f + d) d++    description _ = "Cross"++-- get the Rectangle for the focused window+mainRect :: Rectangle -> Rational -> Rectangle+mainRect (Rectangle rx ry rw rh) f = Rectangle+                                     (rx + (fromIntegral (rw <%> invf)))+                                     (ry + (fromIntegral (rh <%> invf)))+                                     (rw <%> f) (rh <%> f)+    where invf = (1/2) * (1-f)++-- get the rectangles for the up windows+upRects :: Rectangle -> Rational -> [Rectangle]+upRects r f = [topRectangle r nf, rightRectangle r nf]+    where nf = f * (8/10)++-- get the rectangles for the down windows+downRects :: Rectangle -> Rational -> [Rectangle]+downRects r f = [bottomRectangle r nf, leftRectangle r nf]+    where nf = f * (8/10)++topRectangle :: Rectangle -> Rational -> Rectangle+topRectangle (Rectangle rx ry rw rh) f = Rectangle+                                         (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))+                                         ry+                                         (rw <%> f) (rh <%> ((1-f)*(1/2)))++rightRectangle :: Rectangle -> Rational -> Rectangle+rightRectangle (Rectangle rx ry rw rh) f = Rectangle+                                           (rx + (fromIntegral (rw - (rw <%> (1/2)))))+                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))+                                           (rw <%> (1/2)) (rh <%> f)++bottomRectangle :: Rectangle -> Rational -> Rectangle+bottomRectangle (Rectangle rx ry rw rh) f = Rectangle+                                            (rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))+                                            (ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))+                                            (rw <%> f) (rh <%> ((1-f)*(1/2)))++leftRectangle :: Rectangle -> Rational -> Rectangle+leftRectangle (Rectangle rx ry rw rh) f = Rectangle+                                          rx+                                           (ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))+                                           (rw <%> (1/2)) (rh <%> f)+
+ XMonad/Layout/Decoration.hs view
@@ -0,0 +1,489 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Decoration+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier and a class for easily creating decorated+-- layouts.+-----------------------------------------------------------------------------++module XMonad.Layout.Decoration+    ( -- * Usage:+      -- $usage+      decoration+    , Theme (..), defaultTheme+    , Decoration+    , DecorationMsg (..)+    , DecorationStyle (..)+    , DecorationState (..)+    , DefaultDecoration (..)+    , isInStack, isVisible, isInvisible, isWithin, fi, lookFor+    , module XMonad.Layout.LayoutModifier+    , module XMonad.Layout.DecorationUtils+    ) where++import Data.Maybe+import Data.List++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Hooks.UrgencyHook+import XMonad.Layout.DecorationUtils+import XMonad.Layout.LayoutModifier+import XMonad.Layout.WindowArranger (WindowArrangerMsg (..), diff, listFromList)+import XMonad.Layout.Minimize+import XMonad.Layout.Maximize+import XMonad.Util.NamedWindows (getName)+import XMonad.Util.Invisible+import XMonad.Util.XUtils+import XMonad.Util.Font+import XMonad.PositionStore+import XMonad.Hooks.ManageDocks+import XMonad.Actions.WindowMenu+import Control.Applicative((<$>))+import Foreign.C.Types(CInt)++-- $usage+-- This module is intended for layout developers, who want to decorate+-- their layouts. End users will not find here very much for them.+--+-- For examples of 'DecorationStyle' instances you can have a look at+-- "XMonad.Layout.SimpleDecoration", "XMonad.Layout.Tabbed",+-- "XMonad.Layout.DwmStyle", or "XMonad.Layout.TabBarDecoration".++-- | A layout modifier that, with a 'Shrinker', a 'Theme', a+-- 'DecorationStyle', and a layout, will decorate this layout+-- according to the decoration style provided.+--+-- For some usage examples see "XMonad.Layout.DecorationMadness".+decoration :: (DecorationStyle ds a, Shrinker s) => s -> Theme -> ds a+           -> l a -> ModifiedLayout (Decoration ds s) l a+decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)++-- | A 'Theme' is a record of colors, font etc., to customize a+-- 'DecorationStyle'.+--+-- For a collection of 'Theme's see "XMonad.Util.Themes"+data Theme =+    Theme { activeColor         :: String    -- ^ Color of the active window+          , inactiveColor       :: String    -- ^ Color of the inactive window+          , urgentColor         :: String    -- ^ Color of the urgent window+          , activeBorderColor   :: String    -- ^ Color of the border of the active window+          , inactiveBorderColor :: String    -- ^ Color of the border of the inactive window+          , urgentBorderColor   :: String    -- ^ Color of the border of the urgent window+          , activeTextColor     :: String    -- ^ Color of the text of the active window+          , inactiveTextColor   :: String    -- ^ Color of the text of the inactive window+          , urgentTextColor     :: String    -- ^ Color of the text of the urgent window+          , fontName            :: String    -- ^ Font name+          , decoWidth           :: Dimension -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')+          , decoHeight          :: Dimension -- ^ Height of the decorations+          } deriving (Show, Read)++-- | The default xmonad 'Theme'.+defaultTheme :: Theme+defaultTheme =+    Theme { activeColor         = "#999999"+          , inactiveColor       = "#666666"+          , urgentColor         = "#FFFF00"+          , activeBorderColor   = "#FFFFFF"+          , inactiveBorderColor = "#BBBBBB"+          , urgentBorderColor   = "##00FF00"+          , activeTextColor     = "#FFFFFF"+          , inactiveTextColor   = "#BFBFBF"+          , urgentTextColor     = "#FF0000"+          , fontName            = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+          , decoWidth           = 200+          , decoHeight          = 20+          }++minimizeButtonOffset :: Int+minimizeButtonOffset = 48++maximizeButtonOffset :: Int+maximizeButtonOffset = 25++closeButtonOffset :: Int+closeButtonOffset = 10++buttonSize :: Int+buttonSize = 10++data DecoClickAction = WindowMenu | MinimizeButton | MaximizeButton | CloseButton | Dragging+                        deriving (Show)++-- | A 'Decoration' layout modifier will handle 'SetTheme', a message+-- to dynamically change the decoration 'Theme'.+data DecorationMsg = SetTheme Theme deriving ( Typeable )+instance Message DecorationMsg++-- | The 'Decoration' state component, where the list of decorated+-- window's is zipped with a list of decoration. A list of decoration+-- is a list of tuples, a 'Maybe' 'Window' and a 'Maybe Rectangle'.+-- The 'Window' will be displayed only if the rectangle is of type+-- 'Just'.+data DecorationState =+    DS { decos :: [(OrigWin,DecoWin)]+       , decoFont  :: XMonadFont+       }+type DecoWin = (Maybe Window, Maybe Rectangle)+type OrigWin = (Window,Rectangle)++-- | The 'Decoration' 'LayoutModifier'. This data type is an instance+-- of the 'LayoutModifier' class. This data type will be passed,+-- together with a layout, to the 'ModifiedLayout' type constructor+-- to modify the layout by adding decorations according to a+-- 'DecorationStyle'.+data Decoration ds s a =+    Decoration (Invisible Maybe DecorationState) s Theme (ds a)+    deriving (Show, Read)++-- | The 'DecorationStyle' class, defines methods used in the+-- implementation of the 'Decoration' 'LayoutModifier' instance. A+-- type instance of this class is passed to the 'Decoration' type in+-- order to decorate a layout, by using these methods.+class (Read (ds a), Show (ds a), Eq a) => DecorationStyle ds a where++    -- | The description that the 'Decoration' modifier will display.+    describeDeco :: ds a -> String+    describeDeco ds = show ds++    -- | Shrink the window's rectangle when applying a decoration.+    shrink :: ds a -> Rectangle -> Rectangle -> Rectangle+    shrink _ (Rectangle _ _ _ dh) (Rectangle x y w h) = Rectangle x (y + fi dh) w (h - dh)++    -- | The decoration event hook+    decorationEventHook :: ds a -> DecorationState -> Event -> X ()+    decorationEventHook ds s e = handleMouseFocusDrag ds s e++    decorationWhileDraggingHook :: ds a -> CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y++    decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X ()+    decorationAfterDraggingHook ds (mainw, r) decoWin = handleScreenCrossing mainw decoWin+                                                        >>= decorationAfterDraggingHookAddon ds (mainw, r)++    decorationAfterDraggingHookAddon :: ds a -> (Window, Rectangle) -> Bool -> X ()+    decorationAfterDraggingHookAddon _ _ _ = return ()++    -- | The pure version of the main method, 'decorate'.+    pureDecoration :: ds a -> Dimension -> Dimension -> Rectangle+                   -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> Maybe Rectangle+    pureDecoration _ _ ht _ s _ (w,Rectangle x y wh ht') = if isInStack s w && (ht < ht')+                                                             then Just $ Rectangle x y wh ht+                                                             else Nothing++    -- | Given the theme's decoration width and height, the screen+    -- rectangle, the windows stack, the list of windows and+    -- rectangles returned by the underlying layout and window to be+    -- decorated, tupled with its rectangle, produce a 'Just'+    -- 'Rectangle' or 'Nothing' if the window is not to be decorated.+    decorate :: ds a -> Dimension -> Dimension -> Rectangle+             -> W.Stack a -> [(a,Rectangle)] -> (a,Rectangle) -> X (Maybe Rectangle)+    decorate ds w h r s wrs wr = return $ pureDecoration ds w h r s wrs wr++-- | The default 'DecorationStyle', with just the default methods'+-- implementations.+data DefaultDecoration a = DefaultDecoration deriving ( Read, Show )+instance Eq a => DecorationStyle DefaultDecoration a++-- | The long 'LayoutModifier' instance for the 'Decoration' type.+--+-- In 'redoLayout' we check the state: if there is no state we+-- initialize it.+--+-- The state is 'diff'ed against the list of windows produced by the+-- underlying layout: removed windows get deleted and new ones+-- decorated by 'createDecos', which will call 'decorate' to decide if+-- a window must be given a 'Rectangle', in which case a decoration+-- window will be created.+--+-- After that we resync the updated state with the windows' list and+-- then we process the resynced stated (as we do with a new state).+--+-- First we map the decoration windows, we update each decoration to+-- reflect any decorated window's change, and we insert, in the list+-- of windows and rectangles returned by the underlying layout, the+-- decoration for each window. This way xmonad will restack the+-- decorations and their windows accordingly. At the end we remove+-- invisible\/stacked windows.+--+-- Message handling is quite simple: when needed we release the state+-- component of the 'Decoration' 'LayoutModifier'. Otherwise we call+-- 'handleEvent', which will call the appropriate 'DecorationStyle'+-- methods to perform its tasks.+instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where+    redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do+        releaseResources s+        return ([], Just $ Decoration (I Nothing) sh t ds)+    redoLayout _                                 _ Nothing _  = return ([], Nothing)++    redoLayout (Decoration st sh t ds) sc (Just stack) wrs+        | I Nothing  <- st = initState t ds sc stack wrs >>= processState+        | I (Just s) <- st = do let dwrs  = decos s+                                    (d,a) = curry diff (get_ws dwrs) ws+                                    toDel = todel d dwrs+                                    toAdd = toadd a wrs+                                deleteDecos (map snd toDel)+                                let ndwrs = zip toAdd $ repeat (Nothing,Nothing)+                                ndecos <- resync (ndwrs ++ del_dwrs d dwrs) wrs+                                processState (s {decos = ndecos })+        | otherwise        = return (wrs, Nothing)++        where+          ws        = map fst wrs+          get_w     = fst . fst+          get_ws    = map get_w+          del_dwrs  = listFromList get_w notElem+          find_dw i = fst . snd . flip (!!) i+          todel   d = filter (flip elem d . get_w)+          toadd   a = filter (flip elem a . fst  )++          check_dwr dwr = case dwr of+                            (Nothing, Just dr) -> do dw <- createDecoWindow t dr+                                                     return (Just dw, Just dr)+                            _                 -> return dwr++          resync _         [] = return []+          resync d ((w,r):xs) = case  w `elemIndex` get_ws d of+                                  Just i  -> do dr   <- decorate ds (decoWidth t) (decoHeight t) sc stack wrs (w,r)+                                                dwr  <- check_dwr (find_dw i d, dr)+                                                dwrs <- resync d xs+                                                return $ ((w,r),dwr) : dwrs+                                  Nothing -> resync d xs++          -- We drop any windows that are *precisely* stacked underneath+          -- another window: these must be intended to be tabbed!+          remove_stacked rs ((w,r):xs)+              | r `elem` rs   = remove_stacked rs xs+              | otherwise     = (w,r) : remove_stacked (r:rs) xs+          remove_stacked _ [] = []++          insert_dwr ((w,r),(Just dw,Just dr)) xs = (dw,dr):(w, shrink ds dr r):xs+          insert_dwr (x    ,(     _ ,     _ )) xs = x:xs++          dwrs_to_wrs    = remove_stacked [] . foldr insert_dwr []++          processState s = do let ndwrs = decos s+                              showDecos (map snd ndwrs)+                              updateDecos sh t (decoFont s) ndwrs+                              return (dwrs_to_wrs ndwrs, Just (Decoration (I (Just (s {decos = ndwrs}))) sh t ds))++    handleMess (Decoration (I (Just s@(DS {decos = dwrs}))) sh t ds) m+        | Just e <- fromMessage m                = do decorationEventHook ds s e+                                                      handleEvent sh t s e+                                                      return Nothing+        | Just Hide             <- fromMessage m = do hideDecos (map snd dwrs)+                                                      return Nothing+        | Just (SetTheme nt)    <- fromMessage m = do releaseResources s+                                                      return $ Just $ Decoration (I Nothing) sh nt ds+        | Just ReleaseResources <- fromMessage m = do releaseResources s+                                                      return $ Just $ Decoration (I Nothing) sh t  ds+    handleMess _ _ = return Nothing++    modifierDescription (Decoration _ _ _ ds) = describeDeco ds++-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'+-- only.+handleEvent :: Shrinker s => s -> Theme -> DecorationState -> Event -> X ()+handleEvent sh t (DS dwrs fs) e+    | PropertyEvent {ev_window = w} <- e+    , Just i <- w `elemIndex`             (map (fst . fst) dwrs) = updateDeco sh t fs (dwrs !! i)+    | ExposeEvent   {ev_window = w} <- e+    , Just i <- w `elemIndex` (catMaybes $ map (fst . snd) dwrs) = updateDeco sh t fs (dwrs !! i)+handleEvent _ _ _ _ = return ()++handleMouseFocusDrag :: (DecorationStyle ds a) => ds a -> DecorationState -> Event -> X ()+handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window     = ew+                                                , ev_event_type = et+                                                , ev_x_root     = ex+                                                , ev_y_root     = ey }+    | et == buttonPress+    , Just ((mainw,r), (_, decoRectM)) <- lookFor ew dwrs = do+        let Just (Rectangle dx _ dwh _) = decoRectM+            distFromRight = fi dwh - (ex - fi dx)+            distFromLeft = ex - fi dx+            action = if (fi distFromLeft <= 3 * buttonSize)+                        then WindowMenu+                     else if (fi distFromRight >= closeButtonOffset &&+                              fi distFromRight <= closeButtonOffset + buttonSize)+                                 then CloseButton+                     else if (fi distFromRight >= maximizeButtonOffset &&+                              fi distFromRight <= maximizeButtonOffset + (2 * buttonSize))+                                then MaximizeButton+                     else if (fi distFromRight >= minimizeButtonOffset &&+                              fi distFromRight <= minimizeButtonOffset + buttonSize)+                                then MinimizeButton+                     else Dragging+        focus mainw+        case action of+            WindowMenu -> windowMenu+            CloseButton -> kill+            MinimizeButton -> sendMessage (MinimizeWin mainw)+            MaximizeButton -> sendMessage (maximizeRestore mainw)+            Dragging -> mouseDrag (decorationWhileDraggingHook ds ex ey (mainw, r))+                                    (decorationAfterDraggingHook ds (mainw, r) ew)+handleMouseFocusDrag _ _ _ = return ()++handleDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+handleDraggingInProgress ex ey (_, r) x y = do+    let rect = Rectangle (x - (fi ex - rect_x r))+                         (y - (fi ey - rect_y r))+                         (rect_width  r)+                         (rect_height r)+    sendMessage $ SetGeometry rect++handleScreenCrossing :: Window -> Window -> X Bool+handleScreenCrossing w decoWin = withDisplay $ \d -> do+    root <- asks theRoot+    (_, _, _, px, py, _, _, _) <- io $ queryPointer d root+    ws <- gets windowset+    sc <- fromMaybe (W.current ws) <$> pointScreen (fi px) (fi py)+    maybeWksp <- screenWorkspace $ W.screen sc+    let targetWksp = maybeWksp >>= \wksp -> +                        W.findTag w ws >>= \currentWksp ->+                        if (currentWksp /= wksp)+                            then Just wksp+                            else Nothing+    case targetWksp of+        Just wksp -> do+                        -- find out window under cursor on target workspace+                        -- apparently we have to switch to the workspace first+                        -- to make this work, which unforunately introduces some flicker+                        windows $ \ws' -> W.view wksp ws'+                        (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root++                        -- adjust PositionStore+                        let oldScreenRect = screenRect . W.screenDetail $ W.current ws+                            newScreenRect = screenRect . W.screenDetail $ sc+                        {-- somewhat ugly hack to get proper ScreenRect,+                            creates unwanted inter-dependencies+                            TODO: get ScreenRects in a proper way --}+                        oldScreenRect' <- fmap ($ oldScreenRect) (calcGap [U,D,L,R])+                        newScreenRect' <- fmap ($ newScreenRect) (calcGap [U,D,L,R])+                        wa <- io $ getWindowAttributes d decoWin+                        modifyPosStore (\ps ->+                            posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa)+                                oldScreenRect' newScreenRect')++                        -- set focus correctly so the window will be inserted+                        -- at the correct position on the target workspace+                        -- and then shift the window+                        windows $ \ws' -> W.shiftWin wksp w . W.focusWindow selWin $ ws'++                        -- return True to signal that screen crossing has taken place+                        return True+        Nothing -> return False++-- | Given a window and the state, if a matching decoration is in the+-- state return it with its ('Maybe') 'Rectangle'.+lookFor :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,(Window,Maybe Rectangle))+lookFor w ((wr,(Just dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr))+                                   | otherwise = lookFor w dwrs+lookFor w ((_, (Nothing, _)):dwrs) = lookFor w dwrs+lookFor _ [] = Nothing++-- | Initialize the 'DecorationState' by initializing the font+-- structure and by creating the needed decorations.+initState :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle+          -> W.Stack Window -> [(Window,Rectangle)] -> X DecorationState+initState t ds sc s wrs = do+  fs   <- initXMF (fontName t)+  dwrs <- createDecos t ds sc s wrs wrs+  return $ DS dwrs fs++-- | Delete windows stored in the state and release the font structure.+releaseResources :: DecorationState -> X ()+releaseResources s = do+  deleteDecos (map snd $ decos s)+  releaseXMF  (decoFont s)++-- | Create the decoration windows of a list of windows and their+-- rectangles, by calling the 'decorate' method of the+-- 'DecorationStyle' received.+createDecos :: DecorationStyle ds Window => Theme -> ds Window -> Rectangle -> W.Stack Window+            -> [(Window,Rectangle)] -> [(Window,Rectangle)] -> X [(OrigWin,DecoWin)]+createDecos t ds sc s wrs ((w,r):xs) = do+  deco <- decorate ds (decoWidth t) (decoHeight t) sc s wrs (w,r)+  case deco of+    Just dr -> do dw   <- createDecoWindow t dr+                  dwrs <- createDecos t ds sc s wrs xs+                  return $ ((w,r), (Just dw, Just dr)) : dwrs+    Nothing -> do dwrs <- createDecos t ds sc s wrs xs+                  return $ ((w,r), (Nothing, Nothing)) : dwrs+createDecos _ _ _ _ _ [] = return []++createDecoWindow :: Theme -> Rectangle -> X Window+createDecoWindow t r = let mask = Just (exposureMask .|. buttonPressMask) in+                       createNewWindow r mask (inactiveColor t) True++showDecos :: [DecoWin] -> X ()+showDecos = showWindows . catMaybes . map fst++hideDecos :: [DecoWin] -> X ()+hideDecos = hideWindows . catMaybes . map fst++deleteDecos :: [DecoWin] -> X ()+deleteDecos = deleteWindows . catMaybes . map fst++updateDecos :: Shrinker s => s -> Theme -> XMonadFont -> [(OrigWin,DecoWin)] -> X ()+updateDecos s t f = mapM_ $ updateDeco s t f++-- | Update a decoration window given a shrinker, a theme, the font+-- structure and the needed 'Rectangle's+updateDeco :: Shrinker s => s -> Theme -> XMonadFont -> (OrigWin,DecoWin) -> X ()+updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do+  nw  <- getName w+  ur  <- readUrgents+  dpy <- asks display+  let focusColor win ic ac uc = (maybe ic (\focusw -> case () of+                                                       _ | focusw == win -> ac+                                                         | win `elem` ur -> uc+                                                         | otherwise     -> ic) . W.peek)+                                `fmap` gets windowset+  (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)+                                  (activeColor   t, activeBorderColor   t, activeTextColor   t)+                                  (urgentColor   t, urgentBorderColor   t, urgentTextColor   t)+  let s = shrinkIt sh+  name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n+                                  return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)+  let (als, strs) = ([AlignLeft, AlignCenter, AlignRightOffset minimizeButtonOffset,+                        AlignRightOffset maximizeButtonOffset, AlignRightOffset closeButtonOffset]+                    ,[" (M)"    , name      , "_"                                  ,+                        "[]"               , "X"])+  paintAndWrite dw fs wh ht 1 bc borderc tc bc als strs+updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w+updateDeco _ _ _ _ = return ()++-- | True if the window is in the 'Stack'. The 'Window' comes second+-- to facilitate list processing, even though @w \`isInStack\` s@ won't+-- work...;)+isInStack :: Eq a => W.Stack a -> a -> Bool+isInStack s = flip elem (W.integrate s)++-- | Given a 'Rectangle' and a list of 'Rectangle's is True if the+-- 'Rectangle' is not completely contained by any 'Rectangle' of the+-- list.+isVisible :: Rectangle -> [Rectangle] -> Bool+isVisible r = and . foldr f []+    where f x xs = if r `isWithin` x then False : xs else True : xs++-- | The contrary of 'isVisible'.+isInvisible :: Rectangle -> [Rectangle] -> Bool+isInvisible r = not . isVisible r++-- | True is the first 'Rectangle' is totally within the second+-- 'Rectangle'.+isWithin :: Rectangle -> Rectangle -> Bool+isWithin (Rectangle x y w h) (Rectangle rx ry rw rh)+    | x >= rx, x <= rx + fi rw+    , y >= ry, y <= ry + fi rh+    , x + fi w <= rx + fi rw+    , y + fi h <= ry + fi rh = True+    | otherwise              = False
+ XMonad/Layout/DecorationMadness.hs view
@@ -0,0 +1,600 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationMadness+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A collection of decorated layouts: some of them may be nice, some+-- usable, others just funny.+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationMadness+    ( -- * Usage+      -- $usage++      -- * Decorated layouts based on Circle+      -- $circle+      circleSimpleDefault+    , circleDefault+    , circleSimpleDefaultResizable+    , circleDefaultResizable+    , circleSimpleDeco+    , circleSimpleDecoResizable+    , circleDeco+    , circleDecoResizable+    , circleSimpleDwmStyle+    , circleDwmStyle+    , circleSimpleTabbed+    , circleTabbed+    -- * Decorated layouts based on Accordion+    -- $accordion+    , accordionSimpleDefault+    , accordionDefault+    , accordionSimpleDefaultResizable+    , accordionDefaultResizable+    , accordionSimpleDeco+    , accordionSimpleDecoResizable+    , accordionDeco+    , accordionDecoResizable+    , accordionSimpleDwmStyle+    , accordionDwmStyle+    , accordionSimpleTabbed+    , accordionTabbed+    -- * Tall decorated layouts+    -- $tall+    , tallSimpleDefault+    , tallDefault+    , tallSimpleDefaultResizable+    , tallDefaultResizable+    , tallSimpleDeco+    , tallDeco+    , tallSimpleDecoResizable+    , tallDecoResizable+    , tallSimpleDwmStyle+    , tallDwmStyle+    , tallSimpleTabbed+    , tallTabbed+    -- * Mirror Tall decorated layouts+    -- $mirror+    , mirrorTallSimpleDefault+    , mirrorTallDefault+    , mirrorTallSimpleDefaultResizable+    , mirrorTallDefaultResizable+    , mirrorTallSimpleDeco+    , mirrorTallDeco+    , mirrorTallSimpleDecoResizable+    , mirrorTallDecoResizable+    , mirrorTallSimpleDwmStyle+    , mirrorTallDwmStyle+    , mirrorTallSimpleTabbed+    , mirrorTallTabbed+    -- * Floating decorated layouts+    -- $float+    , floatSimpleSimple+    , floatSimple+    , floatSimpleDefault+    , floatDefault+    , floatSimpleDwmStyle+    , floatDwmStyle+    , floatSimpleTabbed+    , floatTabbed+    , defaultTheme, shrinkText+    ) where++import XMonad+import XMonad.Actions.MouseResize+import XMonad.Layout.Decoration+import XMonad.Layout.DwmStyle+import XMonad.Layout.SimpleDecoration+import XMonad.Layout.TabBarDecoration++import XMonad.Layout.Accordion+import XMonad.Layout.Circle+import XMonad.Layout.ResizeScreen+import XMonad.Layout.WindowArranger+import XMonad.Layout.SimpleFloat++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.DecorationMadness+--+-- Then edit your @layoutHook@ by adding the layout you want:+--+-- > main = xmonad defaultConfig { layoutHook = someMadLayout }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You can also edit the default theme:+--+-- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000"+-- >                        , activeTextColor     = "#00FF00" }+--+-- and+--+-- > mylayout = tabbed shrinkText myTheme ||| Full ||| etc..+--+-- When a layout is resizable, this means two different things: you+-- can grab a window's decoration with the pointer and move it around,+-- and you can move and resize windows with the keyboard. For setting+-- up the key bindings, please read the documentation of+-- "XMonad.Layout.WindowArranger"+--+-- The deafult theme can be dynamically change with the xmonad theme+-- selector. See "XMonad.Prompt.Theme". For more themse, look at+-- "XMonad.Util.Themes"++-- $circle+-- Here you will find 'Circle' based decorated layouts.++-- | A 'Circle' layout with the xmonad default decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefault.png>+circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window+circleSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Circle++-- | Similar to 'circleSimpleDefault' but with the possibility of+-- setting a custom shrinker and a custom theme.+circleDefault :: Shrinker s => s -> Theme+              -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window+circleDefault s t = decoration s t DefaultDecoration Circle++-- | A 'Circle' layout with the xmonad simple decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDeco.png>+circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window+circleSimpleDeco = decoration shrinkText defaultTheme (Simple True) Circle++-- | Similar to 'circleSimpleDece' but with the possibility of+-- setting a custom shrinker and a custom theme.+circleDeco :: Shrinker s => s -> Theme+           -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window+circleDeco s t = decoration s t (Simple True) Circle++-- | A 'Circle' layout with the xmonad default decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefaultResizable.png>+circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window+circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Circle)++-- | Similar to 'circleSimpleDefaultResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+circleDefaultResizable :: Shrinker s => s -> Theme+                       -> ModifiedLayout (Decoration DefaultDecoration s)+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window+circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle)++-- | A 'Circle' layout with the xmonad simple decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDecoResizable.png>+circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window+circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Circle)++-- | Similar to 'circleSimpleDecoResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+circleDecoResizable :: Shrinker s => s -> Theme+                    -> ModifiedLayout (Decoration SimpleDecoration s)+                       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window+circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle)++-- | A 'Circle' layout with the xmonad DwmStyle decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDwmStyle.png>+circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window+circleSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Circle++-- | Similar to 'circleSimpleDwmStyle' but with the+-- possibility of setting a custom shrinker and a custom theme.+circleDwmStyle :: Shrinker s => s -> Theme+               -> ModifiedLayout (Decoration DwmStyle s) Circle Window+circleDwmStyle s t = decoration s t Dwm Circle++-- | A 'Circle' layout with the xmonad tabbed decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleTabbed.png>+circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window+circleSimpleTabbed = simpleTabBar Circle++-- | Similar to 'circleSimpleTabbed' but with the+-- possibility of setting a custom shrinker and a custom theme.+circleTabbed :: Shrinker s => s -> Theme+             -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window+circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle)+++-- $accordion+-- Here you will find decorated layouts based on the 'Accordion'+-- layout.++-- | An 'Accordion' layout with the xmonad default decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDefault.png>+accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window+accordionSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Accordion++-- | Similar to 'accordionSimpleDefault' but with the possibility of+-- setting a custom shrinker and a custom theme.+accordionDefault :: Shrinker s => s -> Theme+                 -> ModifiedLayout (Decoration DefaultDecoration s) Accordion Window+accordionDefault s t = decoration s t DefaultDecoration Accordion++-- | An 'Accordion' layout with the xmonad simple decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDeco.png>+accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window+accordionSimpleDeco = decoration shrinkText defaultTheme (Simple True) Accordion++-- | Similar to 'accordionSimpleDece' but with the possibility of+-- setting a custom shrinker and a custom theme.+accordionDeco :: Shrinker s => s -> Theme+              -> ModifiedLayout (Decoration SimpleDecoration s) Accordion Window+accordionDeco s t = decoration s t (Simple True) Accordion++-- | An 'Accordion' layout with the xmonad default decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)+                                   (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window+accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Accordion)++-- | Similar to 'accordionSimpleDefaultResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+accordionDefaultResizable :: Shrinker s => s -> Theme+                          -> ModifiedLayout (Decoration DefaultDecoration s)+                             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window+accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Accordion)++-- | An 'Accordion' layout with the xmonad simple decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+                                (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window+accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Accordion)++-- | Similar to 'accordionSimpleDecoResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+accordionDecoResizable :: Shrinker s => s -> Theme+                       -> ModifiedLayout (Decoration SimpleDecoration s)+                          (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window+accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Accordion)++-- | An 'Accordion' layout with the xmonad DwmStyle decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDwmStyle.png>+accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window+accordionSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Accordion++-- | Similar to 'accordionSimpleDwmStyle' but with the+-- possibility of setting a custom shrinker and a custom theme.+accordionDwmStyle :: Shrinker s => s -> Theme+                  -> ModifiedLayout (Decoration DwmStyle s) Accordion Window+accordionDwmStyle s t = decoration s t Dwm Accordion++-- | An 'Accordion' layout with the xmonad tabbed decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleTabbed.png>+accordionSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Accordion) Window+accordionSimpleTabbed = simpleTabBar Accordion++-- | Similar to 'accordionSimpleTabbed' but with the+-- possibility of setting a custom shrinker and a custom theme.+accordionTabbed :: Shrinker s => s -> Theme+                -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Accordion) Window+accordionTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Accordion)+++-- $tall+-- In this section you will find decorated layouts based on the+-- 'Tall' layout.++tall :: Tall Window+tall = Tall 1 (3/100) (1/2)++-- | A 'Tall' layout with the xmonad default decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefault.png>+tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window+tallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration tall++-- | Similar to 'tallSimpleDefault' but with the possibility of+-- setting a custom shrinker and a custom theme.+tallDefault :: Shrinker s => s -> Theme+            -> ModifiedLayout (Decoration DefaultDecoration s) Tall Window+tallDefault s t = decoration s t DefaultDecoration tall++-- | A 'Tall' layout with the xmonad simple decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDeco.png>+tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window+tallSimpleDeco = decoration shrinkText defaultTheme (Simple True) tall++-- | Similar to 'tallSimpleDece' but with the possibility of+-- setting a custom shrinker and a custom theme.+tallDeco :: Shrinker s => s -> Theme+         -> ModifiedLayout (Decoration SimpleDecoration s) Tall Window+tallDeco s t = decoration s t (Simple True) tall++-- | A 'Tall' layout with the xmonad default decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefaultResizable.png>+tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)+                              (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window+tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange tall)++-- | Similar to 'tallSimpleDefaultResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+tallDefaultResizable :: Shrinker s => s -> Theme+                     -> ModifiedLayout (Decoration DefaultDecoration s)+                        (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window+tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange tall)++-- | A 'Tall' layout with the xmonad simple decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDecoResizable.png>+tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+                           (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window+tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange tall)++-- | Similar to 'tallSimpleDecoResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+tallDecoResizable :: Shrinker s => s -> Theme+                  -> ModifiedLayout (Decoration SimpleDecoration s)+                     (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window+tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange tall)++-- | A 'Tall' layout with the xmonad DwmStyle decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDwmStyle.png>+tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window+tallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm tall++-- | Similar to 'tallSimpleDwmStyle' but with the+-- possibility of setting a custom shrinker and a custom theme.+tallDwmStyle :: Shrinker s => s -> Theme+             -> ModifiedLayout (Decoration DwmStyle s) Tall Window+tallDwmStyle s t = decoration s t Dwm tall++-- | A 'Tall' layout with the xmonad tabbed decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleTabbed.png>+tallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Tall) Window+tallSimpleTabbed = simpleTabBar tall++-- | Similar to 'tallSimpleTabbed' but with the+-- possibility of setting a custom shrinker and a custom theme.+tallTabbed :: Shrinker s => s -> Theme+           -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Tall) Window+tallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) tall)++-- $mirror+-- In this section you will find decorated layouts based on the+-- 'Mirror' layout modifier applied to 'Tall'.++mirrorTall :: Mirror Tall Window+mirrorTall = Mirror tall++-- | A 'Mirror Tall' layout with the xmonad default decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefault.png>+mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window+mirrorTallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration mirrorTall++-- | Similar to 'mirrorTallSimpleDefault' but with the possibility of+-- setting a custom shrinker and a custom theme.+mirrorTallDefault :: Shrinker s => s -> Theme+                  -> ModifiedLayout (Decoration DefaultDecoration s) (Mirror Tall) Window+mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall++-- | A 'Mirror Tall' layout with the xmonad simple decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDeco.png>+mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window+mirrorTallSimpleDeco = decoration shrinkText defaultTheme (Simple True) mirrorTall++-- | Similar to 'mirrorTallSimpleDece' but with the possibility of+-- setting a custom shrinker and a custom theme.+mirrorTallDeco :: Shrinker s => s -> Theme+               -> ModifiedLayout (Decoration SimpleDecoration s) (Mirror Tall) Window+mirrorTallDeco s t = decoration s t (Simple True) mirrorTall++-- | A 'Mirror Tall' layout with the xmonad default decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefaultResizable.png>+mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)+                                    (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window+mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange mirrorTall)++-- | Similar to 'mirrorTallSimpleDefaultResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+mirrorTallDefaultResizable :: Shrinker s => s -> Theme+                           -> ModifiedLayout (Decoration DefaultDecoration s)+                              (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window+mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange mirrorTall)++-- | A 'Mirror Tall' layout with the xmonad simple decoration, default+-- theme and default shrinker, but with the possibility of moving+-- windows with the mouse, and resize\/move them with the keyboard.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDecoResizable.png>+mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+                                 (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window+mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange mirrorTall)++-- | Similar to 'mirrorTallSimpleDecoResizable' but with the+-- possibility of setting a custom shrinker and a custom theme.+mirrorTallDecoResizable :: Shrinker s => s -> Theme+                        -> ModifiedLayout (Decoration SimpleDecoration s)+                           (ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window+mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange mirrorTall)++-- | A 'Mirror Tall' layout with the xmonad DwmStyle decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDwmStyle.png>+mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window+mirrorTallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm mirrorTall++-- | Similar to 'mirrorTallSimpleDwmStyle' but with the+-- possibility of setting a custom shrinker and a custom theme.+mirrorTallDwmStyle :: Shrinker s => s -> Theme+                   -> ModifiedLayout (Decoration DwmStyle s) (Mirror Tall) Window+mirrorTallDwmStyle s t = decoration s t Dwm mirrorTall++-- | A 'Mirror Tall' layout with the xmonad tabbed decoration, default+-- theme and default shrinker.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleTabbed.png>+mirrorTallSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen (Mirror Tall)) Window+mirrorTallSimpleTabbed = simpleTabBar mirrorTall++-- | Similar to 'mirrorTallSimpleTabbed' but with the+-- possibility of setting a custom shrinker and a custom theme.+mirrorTallTabbed :: Shrinker s => s -> Theme+                 -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen (Mirror Tall)) Window+mirrorTallTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) mirrorTall)++-- $float+-- Here you will find decorated layout based on the SimpleFloating+-- layout++-- | A simple floating layout where every window is placed according+-- to the window's initial attributes.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleSimple.png>+floatSimpleSimple :: (Show a, Eq a) => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+	             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatSimpleSimple = simpleFloat++floatSimple :: (Show a, Eq a, Shrinker s) => s -> Theme ->+               ModifiedLayout (Decoration SimpleDecoration s)+	      (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatSimple = simpleFloat'++-- | This version is decorated with the 'DefaultDecoration' style.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDefault.png>+floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)+	              (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20)++-- | Same as 'floatSimpleDefault', but with the possibility of setting a+-- custom shrinker and a custom theme.+floatDefault :: (Show a, Eq a, Shrinker s) => s -> Theme ->+                ModifiedLayout (Decoration DefaultDecoration s)+	       (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrangeAll $ SF (decoHeight t))++-- | This version is decorated with the 'DwmStyle'. Note that this is+-- a keyboard only floating layout.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDwmStyle.png>+floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker)+	               (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (mouseResize $ windowArrangeAll $ SF 20)++-- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a+-- custom shrinker and a custom theme.+floatDwmStyle :: (Show a, Eq a, Shrinker s) => s -> Theme ->+                 ModifiedLayout (Decoration DwmStyle s)+	        (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (decoHeight t))++-- | This version is decorated with the 'TabbedDecoration' style.+-- | Mouse dragging is somehow weird.+--+-- Here you can find a screen shot:+--+-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleTabbed.png>+floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)+	             (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatSimpleTabbed = tabBar shrinkText defaultTheme Top (mouseResize $ windowArrangeAll $ SF 20)++-- | Same as 'floatSimpleTabbed', but with the possibility of setting a+-- custom shrinker and a custom theme.+floatTabbed :: (Show a, Eq a, Shrinker s) => s -> Theme ->+               ModifiedLayout (Decoration TabBarDecoration s)+	      (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+floatTabbed s t = tabBar s t Top (mouseResize $ windowArrangeAll $ SF (decoHeight t))
+ XMonad/Layout/DecorationUtils.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DecorationUtils+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-----------------------------------------------------------------------------++module XMonad.Layout.DecorationUtils+    ( Shrinker (..), DefaultShrinker+    , shrinkText, CustomShrink ( CustomShrink ), shrinkWhile+    ) where++import XMonad++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/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,137 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DragPane+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>+--                    David Roundy <droundy@darcs.net>,+--                    Andrea Rossato <andrea.rossato@unibz.it>+-- License     :  BSD3-style (see LICENSE)+-- +-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layouts that splits the screen either horizontally or vertically and+-- shows two windows.  The first window is always the master window, and+-- the other is either the currently focused window or the second window in+-- layout order.++-----------------------------------------------------------------------------++module XMonad.Layout.DragPane (+                               -- * Usage+                               -- $usage+                                dragPane+                              , DragPane, DragType (..)+                              ) where++import XMonad+import Data.Unique++import qualified XMonad.StackSet as W +import XMonad.Util.Invisible+import XMonad.Util.XUtils++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.DragPane+--+-- Then edit your @layoutHook@ by adding the DragPane layout:+--+-- > myLayouts = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++halfHandleWidth :: Integral a => a+halfHandleWidth = 1++handleColor :: String+handleColor = "#000000"++dragPane :: DragType -> Double -> Double -> DragPane a+dragPane t x y = DragPane (I Nothing) t x y++data DragPane a = +    DragPane (Invisible Maybe (Window,Rectangle,Int)) DragType Double Double +             deriving ( Show, Read )++data DragType = Horizontal | Vertical deriving ( Show, Read )++instance LayoutClass DragPane a where+    doLayout d@(DragPane _ Vertical   _ _) = doLay id d+    doLayout d@(DragPane _ Horizontal _ _) = doLay mirrorRect d+    handleMessage = handleMess++data SetFrac = SetFrac Int Double deriving ( Show, Read, Eq, Typeable )+instance Message SetFrac++handleMess :: DragPane a -> SomeMessage -> X (Maybe (DragPane a))+handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x+    | Just e <- fromMessage x :: Maybe Event = do handleEvent d e+                                                  return Nothing+    | Just Hide             <- fromMessage x = do hideWindow win+                                                  return $ Just (DragPane mb ty delta split)+    | Just ReleaseResources <- fromMessage x = do deleteWindow win+                                                  return $ Just (DragPane (I Nothing) ty delta split)+    -- layout specific messages+    | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))+    | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do+                                     return $ Just (DragPane mb ty delta frac)+handleMess _ _ = return Nothing++handleEvent :: DragPane a -> Event -> X ()+handleEvent (DragPane (I (Just (win,r,ident))) ty _ _) +            (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })+    | t == buttonPress && thisw == win || thisbw == win  = do+  mouseDrag (\ex ey -> do+             let frac = case ty of+                        Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)+                        Horizontal -> (fromIntegral ey - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width r)+             sendMessage (SetFrac ident frac))+            (return ())+handleEvent _ _  = return ()++doLay :: (Rectangle -> Rectangle) -> DragPane a -> Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (DragPane a))+doLay mirror (DragPane mw ty delta split) r s = do+  let r' = mirror r+      (left', right') = splitHorizontallyBy split r'+      left = case left' of Rectangle x y w h ->+                               mirror $ Rectangle x y (w-halfHandleWidth) h+      right = case right' of+                Rectangle x y w h ->+                    mirror $ Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h+      handr = case left' of+                Rectangle x y w h ->+                    mirror $ Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h+      wrs = case reverse (W.up s) of+              (master:_) -> [(master,left),(W.focus s,right)]+              [] -> case W.down s of+                      (next:_) -> [(W.focus s,left),(next,right)]+                      [] -> [(W.focus s, r)]+  if length wrs > 1 +     then case mw of+            I (Just (w,_,ident)) -> do +                    w' <- deleteWindow w >> newDragWin handr+                    return (wrs, Just $ DragPane (I $ Just (w',r',ident)) ty delta split)+            I Nothing -> do +                    w <- newDragWin handr+                    i <- io $ newUnique+                    return (wrs, Just $ DragPane (I $ Just (w,r',hashUnique i)) ty delta split)+     else return (wrs, Nothing)+++newDragWin :: Rectangle -> X Window+newDragWin r = do+  let mask = Just $ exposureMask .|. buttonPressMask+  w <- createNewWindow r mask handleColor False+  showWindow  w+  d <- asks display+  liftIO $ lowerWindow d w+  return      w
+ XMonad/Layout/DraggingVisualizer.hs view
@@ -0,0 +1,44 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DraggingVisualizer+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.DraggingVisualizer+    ( draggingVisualizer,+      DraggingVisualizerMsg (..)+    ) where++import XMonad+import XMonad.Layout.LayoutModifier++data DraggingVisualizer a = DraggingVisualizer (Maybe (Window, Rectangle)) deriving ( Read, Show )+draggingVisualizer :: LayoutClass l Window => l Window -> ModifiedLayout DraggingVisualizer l Window+draggingVisualizer = ModifiedLayout $ DraggingVisualizer Nothing++data DraggingVisualizerMsg = DraggingWindow Window Rectangle+                                | DraggingStopped+                                deriving ( Typeable, Eq )+instance Message DraggingVisualizerMsg++instance LayoutModifier DraggingVisualizer Window where+    modifierDescription (DraggingVisualizer _) = "DraggingVisualizer"+    pureModifier (DraggingVisualizer (Just dragged@(draggedWin, _))) _ _ wrs =+            if draggedWin `elem` (map fst wrs)+                then (dragged : rest, Nothing)+                else (wrs, Just $ DraggingVisualizer Nothing)+        where+            rest = filter (\(w, _) -> w /= draggedWin) wrs+    pureModifier _ _ _ wrs = (wrs, Nothing)++    pureMess (DraggingVisualizer _) m = case fromMessage m of+        Just (DraggingWindow w rect) -> Just $ DraggingVisualizer $ Just (w, rect)+        Just (DraggingStopped) -> Just $ DraggingVisualizer Nothing+        _ -> Nothing
+ XMonad/Layout/DwmStyle.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.DwmStyle+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier for decorating windows in a dwm like style.+-----------------------------------------------------------------------------++module XMonad.Layout.DwmStyle+    ( -- * Usage:+      -- $usage+      dwmStyle+    , Theme (..)+    , defaultTheme+    , DwmStyle (..)+    , shrinkText, CustomShrink(CustomShrink)+    , Shrinker(..)+    ) where++import XMonad+import XMonad.StackSet ( Stack (..) )+import XMonad.Layout.Decoration++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.DwmStyle+--+-- Then edit your @layoutHook@ by adding the DwmStyle decoration to+-- your layout:+--+-- > myL = dwmStyle shrinkText defaultTheme (layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You can also edit the default configuration options.+--+-- > myDWConfig = defaultTheme { inactiveBorderColor = "red"+-- >                           , inactiveTextColor   = "red"}+--+-- and+--+-- > myL = dwmStyle shrinkText myDWConfig (layoutHook defaultConfig)+--+-- A complete xmonad.hs file for this would therefore be:+--+-- > import XMonad+-- > import XMonad.Layout.DwmStyle+-- >+-- > main = xmonad defaultConfig {+-- >                    layoutHook =+-- >                        dwmStyle shrinkText defaultTheme+-- >                            (layoutHook defaultConfig)+-- >              }+--+++-- | Add simple old dwm-style decorations to windows of a layout.+dwmStyle :: (Eq a, Shrinker s) => s -> Theme+         -> l a -> ModifiedLayout (Decoration DwmStyle s) l a+dwmStyle s c = decoration s c Dwm++data DwmStyle a = Dwm deriving (Show, Read)++instance Eq a => DecorationStyle DwmStyle a where+    describeDeco _ = "DwmStyle"+    shrink  _ _  r = r+    pureDecoration _ wh ht _ s@(Stack fw _ _) _ (w,Rectangle x y wid _) =+        if w == fw || not (isInStack s w) then Nothing else Just $ Rectangle (fi nx) y nwh (fi ht)+            where nwh = min wid $ fi wh+                  nx  = fi x + wid - nwh
+ XMonad/Layout/FixedColumn.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.FixedColumn+-- Copyright   :  (c) 2008 Justin Bogner <mail@justinbogner.com>+-- License     :  BSD3-style (as xmonad)+--+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout much like Tall, but using a multiple of a window's minimum+-- resize amount instead of a percentage of screen to decide where to+-- split. This is useful when you usually leave a text editor or+-- terminal in the master pane and like it to be 80 columns wide.+--+-----------------------------------------------------------------------------++module XMonad.Layout.FixedColumn (+    -- * Usage+    -- $usage+        FixedColumn(..)+) where++import Control.Monad (msum)+import Data.Maybe (fromMaybe)+import Graphics.X11.Xlib (Window, rect_width)+import Graphics.X11.Xlib.Extras ( getWMNormalHints+                                , getWindowAttributes+                                , sh_base_size+                                , sh_resize_inc+                                , wa_border_width)++import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)+import XMonad.Layout (Resize(..), IncMasterN(..), tile)+import XMonad.StackSet as W++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.FixedColumn+--+-- Then edit your @layoutHook@ by adding the FixedColumn layout:+--+-- > myLayouts = FixedColumn 1 20 80 10 ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | A tiling mode based on preserving a nice fixed width+--   window. Supports 'Shrink', 'Expand' and 'IncMasterN'.+data FixedColumn a = FixedColumn !Int -- Number of windows in the master pane+                                 !Int -- Number to increment by when resizing+                                 !Int -- Default width of master pane+                                 !Int -- Column width for normal windows+                        deriving (Read, Show)++instance LayoutClass FixedColumn Window where+    doLayout (FixedColumn nmaster _ ncol fallback) r s = do+            fws <- mapM (widthCols fallback ncol) ws+            let frac = maximum (take nmaster fws) // rect_width r+                rs   = tile frac r nmaster (length ws)+            return $ (zip ws rs, Nothing)+        where ws     = W.integrate s+              x // y = fromIntegral x / fromIntegral y++    pureMessage (FixedColumn nmaster delta ncol fallback) m =+            msum [fmap resize     (fromMessage m)+                 ,fmap incmastern (fromMessage m)]+        where resize Shrink+                  = FixedColumn nmaster delta (max 0 $ ncol - delta) fallback+              resize Expand+                  = FixedColumn nmaster delta (ncol + delta) fallback+              incmastern (IncMasterN d)+                  = FixedColumn (max 0 (nmaster+d)) delta ncol fallback++    description _ = "FixedColumn"++-- | Determine the width of @w@ given that we would like it to be @n@+--   columns wide, using @inc@ as a resize increment for windows that+--   don't have one+widthCols :: Int -> Int -> Window -> X Int+widthCols inc n w = withDisplay $ \d -> io $ do+    sh <- getWMNormalHints d w+    bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w+    let widthHint f = f sh >>= return . fromIntegral . fst+        oneCol      = fromMaybe inc $ widthHint sh_resize_inc+        base        = fromMaybe 0 $ widthHint sh_base_size+    return $ 2 * bw + base + n * oneCol
+ XMonad/Layout/Gaps.hs view
@@ -0,0 +1,148 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-- for now, use -fglasgow-exts for compatibility with ghc 6.6, which chokes+-- on some of the LANGUAGE pragmas below+{- LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances -}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Gaps+-- Copyright   :  (c) 2008 Brent Yorgey+-- License     :  BSD3+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Create manually-sized gaps along edges of the screen which will not+-- be used for tiling, along with support for toggling gaps on and+-- off.+--+-- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for+-- leaving space for your dock-type applications (status bars,+-- toolbars, docks, etc.), since it automatically sets up appropriate+-- gaps, allows them to be toggled, etc.  However, this module may+-- still be useful in some situations where the automated approach of+-- ManageDocks does not work; for example, to work with a dock-type+-- application that does not properly set the STRUTS property, or to+-- leave part of the screen blank which is truncated by a projector,+-- and so on.+-----------------------------------------------------------------------------++module XMonad.Layout.Gaps (+                               -- * Usage+                               -- $usage+                          Direction(..),+                          GapSpec, gaps, GapMessage(..)++                          ) where++import XMonad.Core+import Graphics.X11 (Rectangle(..))++import XMonad.Hooks.ManageDocks (Direction(..))+import XMonad.Layout.LayoutModifier++import Data.List (delete)++-- $usage+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Layout.Gaps+--+-- and applying the 'gaps' modifier to your layouts as follows (for+-- example):+--+-- > layoutHook = gaps [(U,18), (R,23)] $ Tall 1 (3/100) (1/2) ||| Full  -- leave gaps at the top and right+--+-- You can additionally add some keybindings to toggle or modify the gaps,+-- for example:+--+-- > , ((modMask x .|. controlMask, xK_g), sendMessage $ ToggleGaps)  -- toggle all gaps+-- > , ((modMask x .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap+-- > , ((modMask x .|. controlMask, xK_w), sendMessage $ IncGap R 5)  -- increment the right-hand gap+-- > , ((modMask x .|. controlMask, xK_q), sendMessage $ DecGap R 5)  -- decrement the right-hand gap+--+-- If you want complete control over all gaps, you could include+-- something like this in your keybindings, assuming in this case you+-- are using 'XMonad.Util.EZConfig.mkKeymap' or+-- 'XMonad.Util.EZConfig.additionalKeysP' from "XMonad.Util.EZConfig"+-- for string keybinding specifications:+--+-- > +++-- > [ ("M-g " ++ f ++ " " ++ k, sendMessage $ m d)+-- >     | (k, d) <- [("a",L), ("s",D), ("w",U), ("d",R)]+-- >     , (f, m) <- [("v", ToggleGap), ("h", IncGap 10), ("f", DecGap 10)]+-- > ]+--+-- Given the above keybinding definition, for example, you could type+-- @M-g, v, a@ to toggle the top gap.+--+-- To configure gaps differently per-screen, use+-- "XMonad.Layout.PerScreen" (coming soon).++-- | A manual gap configuration.  Each side of the screen on which a+--   gap is enabled is paired with a size in pixels.+type GapSpec = [(Direction,Int)]++-- | The gap state.  The first component is the configuration (which+--   gaps are allowed, and their current size), the second is the gaps+--   which are currently active.+data Gaps a = Gaps GapSpec [Direction]+  deriving (Show, Read)++-- | Messages which can be sent to a gap modifier.+data GapMessage = ToggleGaps              -- ^ Toggle all gaps.+                | ToggleGap  !Direction    -- ^ Toggle a single gap.+                | IncGap !Int !Direction    -- ^ Increase a gap by a certain number of pixels.+                | DecGap !Int !Direction    -- ^ Decrease a gap.+  deriving (Typeable)++instance Message GapMessage++instance LayoutModifier Gaps a where+    modifyLayout g w r = runLayout w (applyGaps g r)++    pureMess (Gaps conf cur) m+      | Just ToggleGaps    <- fromMessage m+        = Just $ Gaps conf (toggleGaps conf cur)+      | Just (ToggleGap d) <- fromMessage m+        = Just $ Gaps conf (toggleGap conf cur d)+      | Just (IncGap i d)  <- fromMessage m+        = Just $ Gaps (incGap conf d i) cur+      | Just (DecGap i d)  <- fromMessage m+        = Just $ Gaps (incGap conf d (-i)) cur+      | otherwise = Nothing++applyGaps :: Gaps a -> Rectangle -> Rectangle+applyGaps gs r = foldr applyGap r (activeGaps gs)+  where+    applyGap (U,z) (Rectangle x y w h) = Rectangle x (y + fi z) w (h - fi z)+    applyGap (D,z) (Rectangle x y w h) = Rectangle x y w (h - fi z)+    applyGap (L,z) (Rectangle x y w h) = Rectangle (x + fi z) y (w - fi z) h+    applyGap (R,z) (Rectangle x y w h) = Rectangle x y (w - fi z) h++activeGaps :: Gaps a -> GapSpec+activeGaps (Gaps conf cur) = filter ((`elem` cur) . fst) conf++toggleGaps :: GapSpec -> [Direction] -> [Direction]+toggleGaps conf [] = map fst conf+toggleGaps _    _  = []++toggleGap :: GapSpec -> [Direction] -> Direction -> [Direction]+toggleGap conf cur d | d `elem` cur            = delete d cur+                     | d `elem` (map fst conf) = d:cur+                     | otherwise               = cur++incGap :: GapSpec -> Direction -> Int -> GapSpec+incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs++fi :: (Num b, Integral a) => a -> b+fi = fromIntegral++-- | Add togglable manual gaps to a layout.+gaps :: GapSpec   -- ^ The gaps to allow, paired with their initial sizes.+     -> l a       -- ^ The layout to modify.+     -> ModifiedLayout Gaps l a+gaps g = ModifiedLayout (Gaps g (map fst g))+
+ XMonad/Layout/Grid.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Grid+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A simple layout that attempts to put all windows in a square grid.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Grid (+    -- * Usage+    -- $usage+    Grid(..), arrange, defaultRatio+) 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 }+--+-- You can also specify an aspect ratio for Grid to strive for with the+-- GridRatio constructor.  For example, if you want Grid to try to make a grid+-- four windows wide and three windows tall, you could use+--+-- > myLayouts = GridRatio (4/3) ||| etc.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Grid a = Grid | GridRatio Double deriving (Read, Show)++defaultRatio :: Double+defaultRatio = 16/9++instance LayoutClass Grid a where+    pureLayout Grid          r = pureLayout (GridRatio defaultRatio) r+    pureLayout (GridRatio d) r = arrange d r . integrate++arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)]+arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles+    where+    nwins = length st+    ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)+    mincs = max 1 $ 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/GridVariants.hs view
@@ -0,0 +1,224 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}++----------------------------------------------------------------------+-- |+-- Module      : XMonad.Layout.GridVariants+-- Copyright   : (c) Norbert Zeh+-- License     : BSD-style (see LICENSE)+--+-- Maintainer  : nzeh@cs.dal.ca+-- Stability   : unstable+-- Portability : unportable+--+-- Two layouts: one is a variant of the Grid layout that allows the+-- desired aspect ratio of windows to be specified.  The other is like+-- Tall but places a grid with fixed number of rows and columns in the+-- master area and uses an aspect-ratio-specified layout for the+-- slaves.+----------------------------------------------------------------------++module XMonad.Layout.GridVariants ( -- * Usage+                                    -- $usage+                                    ChangeMasterGeom(..)+                                  , Grid(..)+                                  , TallGrid(..)+                                  , SplitGrid(..)+                                  , Orientation(..)+                                  ) where++import Control.Monad+import XMonad+import qualified XMonad.StackSet as W++-- $usage+-- This module can be used as follows:+--+-- > import XMonad.Layout.GridVariants+--+-- Then add something like this to your layouts:+--+-- > Grid (16/10)+--+-- for a 16:10 aspect ratio grid, or+--+-- > SplitGrid L 2 3 (2/3) (16/10) (5/100)+--+-- for a layout with a 2x3 master grid that uses 2/3 of the screen,+-- and a 16:10 aspect ratio slave grid to its right.  The last+-- parameter is again the percentage by which the split between master+-- and slave area changes in response to Expand/Shrink messages.+--+-- To be able to change the geometry of the master grid, add something+-- like this to your keybindings:+--+-- > ((modMask .|. shiftMask, xK_equal), sendMessage $ IncMasterCols 1),+-- > ((modMask .|. shiftMask, xK_minus), sendMessage $ IncMasterCols (-1)),+-- > ((modMask .|. ctrlMask,  xK_equal), sendMessage $ IncMasterRows 1),+-- > ((modMask .|. ctrlMask,  xK_minus), sendMessage $ IncMasterRows (-1))++-- | Grid layout.  The parameter is the desired x:y aspect ratio of windows+data Grid a = Grid !Rational+              deriving (Read, Show)++instance LayoutClass Grid a where++    pureLayout (Grid aspect) rect st = zip wins rects+        where+          wins  = W.integrate st+          nwins = length wins+          rects = arrangeAspectGrid rect nwins aspect++    description _ = "Grid"++-- | SplitGrid layout.  Parameters are+--+--   - side where the master is+--   - number of master rows+--   - number of master columns+--   - portion of screen used for master grid+--   - x:y aspect ratio of slave windows+--   - increment for resize messages+data SplitGrid a = SplitGrid Orientation !Int !Int !Rational !Rational !Rational+                   deriving (Read, Show)++-- | Type to specify the side of the screen that holds+--   the master area of a SplitGrid.+data Orientation = T | B | L | R+                   deriving (Eq, Read, Show)++instance LayoutClass SplitGrid a where++    pureLayout (SplitGrid o mrows mcols mfrac saspect _) rect st = zip wins rects+        where+          wins  = W.integrate st+          nwins = length wins+          rects = arrangeSplitGrid rect o nwins mrows mcols mfrac saspect++    pureMessage layout msg =+        msum [ fmap (resizeMaster layout) (fromMessage msg)+             , fmap (changeMasterGrid layout) (fromMessage msg) ]++    description _ = "SplitGrid"++-- |The geometry change message understood by the master grid+data ChangeMasterGeom+    = IncMasterRows !Int -- ^Change the number of master rows+    | IncMasterCols !Int -- ^Change the number of master columns+    deriving Typeable++instance Message ChangeMasterGeom++arrangeSplitGrid :: Rectangle -> Orientation -> Int -> Int -> Int -> Rational -> Rational -> [Rectangle]+arrangeSplitGrid rect@(Rectangle rx ry rw rh) o nwins mrows mcols mfrac saspect+    | nwins <= mwins = arrangeMasterGrid rect nwins mcols+    | mwins == 0     = arrangeAspectGrid rect nwins saspect+    | otherwise      = (arrangeMasterGrid mrect mwins mcols) +++                       (arrangeAspectGrid srect swins saspect)+    where+      mwins            = mrows * mcols+      swins            = nwins - mwins+      mrect            = Rectangle mx my mw mh+      srect            = Rectangle sx sy sw sh+      (mh, sh, mw, sw) = if o `elem` [T, B] then+                             (ceiling (fromIntegral rh * mfrac), rh - mh, rw, rw)+                         else+                             (rh, rh, ceiling (fromIntegral rw * mfrac), rw - mw)+      mx               = fromIntegral rx + if o == R then fromIntegral sw else 0+      my               = fromIntegral ry + if o == B then fromIntegral sh else 0+      sx               = fromIntegral rx + if o == L then fromIntegral mw else 0+      sy               = fromIntegral ry + if o == T then fromIntegral mh else 0++arrangeMasterGrid :: Rectangle -> Int -> Int -> [Rectangle]+arrangeMasterGrid rect nwins mcols = arrangeGrid rect nwins (min nwins mcols)++arrangeAspectGrid :: Rectangle -> Int -> Rational -> [Rectangle]+arrangeAspectGrid rect@(Rectangle _ _ rw rh) nwins aspect =+    arrangeGrid rect nwins (min nwins ncols)+    where+      scr_a = fromIntegral rw / fromIntegral rh+      fcols = sqrt ( fromRational $ scr_a * fromIntegral nwins / aspect ) :: Double+      cols1 = floor fcols :: Int+      cols2 = ceiling fcols :: Int+      rows1 = ceiling ( fromIntegral nwins / fromIntegral cols1 :: Rational ) :: Int+      rows2 = floor ( fromIntegral nwins / fromIntegral cols2 :: Rational ) :: Int+      a1    = scr_a * fromIntegral rows1 / fromIntegral cols1+      a2    = scr_a * fromIntegral rows2 / fromIntegral cols2+      ncols | cols1 == 0                = cols2+            | rows2 == 0                = cols1+            | a1 / aspect < aspect / a2 = cols1+            | otherwise                 = cols2++arrangeGrid :: Rectangle -> Int -> Int -> [Rectangle]+arrangeGrid (Rectangle rx ry rw rh) nwins ncols =+    [Rectangle (fromIntegral x + rx) (fromIntegral y + ry) (fromIntegral w) (fromIntegral h)+     | (x, y, w, h) <- rects]+    where+      nrows_in_cols = listDifference $ splitEvenly nwins ncols+      x_slabs       = splitIntoSlabs (fromIntegral rw) ncols+      y_slabs       = [splitIntoSlabs (fromIntegral rh) nrows | nrows <- nrows_in_cols]+      rects_in_cols = [[(x, y, w, h) | (y, h) <- lst]+                       | ((x, w), lst) <- zip x_slabs y_slabs]+      rects         = foldr (++) [] rects_in_cols++splitIntoSlabs :: Int -> Int -> [(Int, Int)]+splitIntoSlabs width nslabs = zip (0:xs) widths+    where+      xs = splitEvenly width nslabs+      widths = listDifference xs++listDifference :: [Int] -> [Int]+listDifference lst = [cur-pre | (cur,pre) <- zip lst (0:lst)]++splitEvenly :: Int -> Int -> [Int]+splitEvenly n parts = [ sz-off | (sz,off) <- zip sizes offsets]+    where+      size    = ceiling ( (fromIntegral n / fromIntegral parts) :: Double )+      extra   = size*parts - n+      sizes   = [i*size | i <- [1..parts]]+      offsets = (take (fromIntegral extra) [1..]) ++ [extra,extra..]++resizeMaster :: SplitGrid a -> Resize -> SplitGrid a+resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Shrink =+    SplitGrid o mrows mcols (max 0 (mfrac - delta)) saspect delta+resizeMaster (SplitGrid o mrows mcols mfrac saspect delta) Expand =+    SplitGrid o mrows mcols (min 1 (mfrac + delta)) saspect delta++changeMasterGrid :: SplitGrid a -> ChangeMasterGeom -> SplitGrid a+changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterRows d) =+    SplitGrid o (max 0 (mrows + d)) mcols mfrac saspect delta+changeMasterGrid (SplitGrid o mrows mcols mfrac saspect delta) (IncMasterCols d) =+    SplitGrid o mrows (max 0 (mcols + d)) mfrac saspect delta++-- | TallGrid layout.  Parameters are+--+--   - number of master rows+--   - number of master columns+--   - portion of screen used for master grid+--   - x:y aspect ratio of slave windows+--   - increment for resize messages+--+--   This exists mostly because it was introduced in an earlier version.+--   It's a fairly thin wrapper around "SplitGrid L".+data TallGrid a = TallGrid !Int !Int !Rational !Rational !Rational+                  deriving (Read, Show)++instance LayoutClass TallGrid a where++    pureLayout (TallGrid mrows mcols mfrac saspect _) rect st = zip wins rects+        where+          wins  = W.integrate st+          nwins = length wins+          rects = arrangeSplitGrid rect L nwins mrows mcols mfrac saspect++    pureMessage layout msg =+        msum [ fmap ((tallGridAdapter resizeMaster) layout) (fromMessage msg)+             , fmap ((tallGridAdapter changeMasterGrid) layout) (fromMessage msg) ]++    description _ = "TallGrid"++tallGridAdapter :: (SplitGrid a -> b -> SplitGrid a) -> TallGrid a -> b -> TallGrid a+tallGridAdapter f (TallGrid mrows mcols mfrac saspect delta) msg =+    TallGrid mrows' mcols' mfrac' saspect' delta'+    where+      SplitGrid _ mrows' mcols' mfrac' saspect' delta' =+          f (SplitGrid L mrows mcols mfrac saspect delta) msg
+ XMonad/Layout/HintedGrid.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.HintedGrid+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A not so simple layout that attempts to put all windows in a square grid+-- while obeying their size hints.+--+-----------------------------------------------------------------------------++module XMonad.Layout.HintedGrid (+    -- * Usage+    -- $usage+    Grid(..), arrange, defaultRatio+) where++import Prelude hiding ((.))++import XMonad+import XMonad.StackSet++import Control.Monad.State+import Data.List+import Data.Ord++infixr 9 .+(.) :: (Functor f) => (a -> b) -> f a -> f b+(.) = fmap++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.HintedGrid+--+-- Then edit your @layoutHook@ by adding the 'Grid' layout:+--+-- > myLayouts = Grid False ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- You can also specify an aspect ratio for Grid to strive for with the+-- GridRatio constructor:+--+-- > myLayouts = GridRatio (4/3) False ||| etc.+--+-- For more detailed instructions on editing the layoutHook see+-- "XMonad.Doc.Extending#Editing_the_layout_hook".++-- | Automatic mirroring of hinted layouts doesn't work very well, so this+-- 'Grid' comes with built-in mirroring. @Grid False@ is the normal layout,+-- @Grid True@ is the mirrored variant (rotated by 90 degrees).+data Grid a = Grid Bool | GridRatio Double Bool deriving (Read, Show)++defaultRatio :: Double+defaultRatio = 16/9++instance LayoutClass Grid Window where+    doLayout (Grid m)        r w = doLayout (GridRatio defaultRatio m) r w+    doLayout (GridRatio d m) r w = flip (,) Nothing . arrange d m r (integrate w)++replicateS :: Int -> (a -> (b, a)) -> a -> ([b], a)+replicateS n = runState . replicateM n . State++doColumn :: Dimension -> Dimension -> Dimension -> [(D -> D)] -> [D]+doColumn width height k adjs =+    let+        (ind, fs) = unzip . sortBy (comparing $ snd . ($ (width, height)) . snd) . zip [0 :: Int ..] $ adjs+        (_, ds) = doC height k fs+    in+    map snd . sortBy (comparing fst) . zip ind $ ds+    where+    doC h _ [] = (h, [])+    doC h n (f : fs) = (adj :) . doC (h - h') (n - 1) fs+        where+        adj@(_, h') = f (width, h `div` n)++doRect :: Dimension -> Dimension -> Dimension -> [[D -> D]] -> [Rectangle]+doRect height = doR+    where+    doR _ _ [] = []+    doR width n (c : cs) =+        let+            v = fromIntegral $ length c+            c' = doColumn (width `div` n) height v c+            (ws, hs) = unzip c'+            maxw = maximum ws+            height' = sum hs+            hbonus = height - height'+            hsingle = hbonus `div` v+            hoffset = hsingle `div` 2+            width' = width - maxw+            ys = map ((height -) . subtract hoffset) . scanl1 (+) . map (hsingle +) $ hs+            xs = map ((width' +) . (`div` 2) . (maxw -)) $ ws+        in+        zipWith3 (\x y (w, h) -> Rectangle (fromIntegral x) (fromIntegral y) w h) xs ys c' ++ doR width' (n - 1) cs++-- | The internal function for computing the grid layout.+arrange :: Double -> Bool -> Rectangle -> [Window] -> X [(Window, Rectangle)]+arrange aspectRatio mirror (Rectangle rx ry rw rh) wins = do+    proto <- mapM mkAdjust wins+    let+        adjs = map (\f -> twist . f . twist) proto+        rs = arrange' aspectRatio (twist (rw, rh)) adjs+        rs' = map (\(Rectangle x y w h) -> uncurry (uncurry Rectangle (twist (x, y))) (twist (w, h))) rs+    return . zip wins . map (\r -> r{ rect_x = rect_x r + rx, rect_y = rect_y r + ry }) $ rs'+    where+    twist+        | mirror = \(a, b) -> (b, a)+        | otherwise = id++arrange' :: Double -> D -> [D -> D] -> [Rectangle]+arrange' aspectRatio (rw, rh) adjs = reverse $ doRect rh rw (fromIntegral ncolumns) (ecols ++ cols)+    where+    nwindows = length adjs+    ncolumns = max 1 . round . sqrt $ fromIntegral nwindows * fromIntegral rw / (fromIntegral rh * aspectRatio)+    nrows = nwindows `div` ncolumns+    nextras = nwindows - ncolumns * nrows+    (ecols, adjs') = replicateS nextras (splitAt (nrows + 1)) $ reverse adjs+    (cols, _) = replicateS (ncolumns - nextras) (splitAt nrows) adjs'
+ XMonad/Layout/HintedTile.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.HintedTile+-- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>+--                Andrea Rossato <andrea.rossato@unibz.it>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A gapless tiled layout that attempts to obey window size hints,+-- rather than simply ignoring them.+--+-----------------------------------------------------------------------------++module XMonad.Layout.HintedTile (+    -- * Usage+    -- $usage+    HintedTile(..), Orientation(..), Alignment(..)+) where++import XMonad hiding (Tall(..))+import qualified XMonad.StackSet as W+import Control.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:+--+-- > myLayout = hintedTile Tall ||| hintedTile Wide ||| Full ||| etc..+-- >   where+-- >      hintedTile = HintedTile nmaster delta ratio TopLeft+-- >      nmaster    = 1+-- >      ratio      = 1/2+-- >      delta      = 3/100+-- > main = xmonad defaultConfig { layoutHook = myLayout }+--+-- Because both Xmonad and Xmonad.Layout.HintedTile define Tall,+-- you need to disambiguate Tall. If you are replacing the+-- built-in Tall with HintedTile, change @import Xmonad@ to+-- @import Xmonad hiding (Tall)@.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data HintedTile a = HintedTile+    { nmaster     :: !Int         -- ^ number of windows in the master pane+    , delta       :: !Rational    -- ^ how much to change when resizing+    , frac        :: !Rational    -- ^ ratio between master/nonmaster panes+    , alignment   :: !Alignment   -- ^ Where to place windows that are smaller+                                  --   than their preordained rectangles.+    , orientation :: !Orientation -- ^ Tall or Wide (mirrored) layout?+    } deriving ( Show, Read )++data Orientation+     = Wide -- ^ Lay out windows similarly to Mirror tiled.+     | Tall -- ^ Lay out windows similarly to tiled.+    deriving ( Show, Read, Eq, Ord )++data Alignment = TopLeft | Center | BottomRight+    deriving ( Show, Read, Eq, Ord )++instance LayoutClass HintedTile Window where+    doLayout (HintedTile { orientation = o, nmaster = nm, frac = f, alignment = al }) r w' = do+        bhs <- mapM mkAdjust w+        let (masters, slaves) = splitAt nm bhs+        return (zip w (tiler masters slaves), Nothing)+     where+        w = W.integrate w'+        tiler masters slaves+            | null masters || null slaves = divide al o (masters ++ slaves) r+            | otherwise = split o f r (divide al o masters) (divide al o slaves)++    pureMessage c m = fmap resize     (fromMessage m) `mplus`+                      fmap incmastern (fromMessage m)+     where+        resize Shrink = c { frac = max 0 $ frac c - delta c }+        resize Expand = c { frac = min 1 $ frac c + delta c }+        incmastern (IncMasterN d) = c { nmaster = max 0 $ nmaster c + d }++    description l = show (orientation l)++align :: Alignment -> Position -> Dimension -> Dimension -> Position+align TopLeft     p _ _ = p+align Center      p a b = p + fromIntegral (a - b) `div` 2+align BottomRight p a b = p + fromIntegral (a - b)++-- Divide the screen vertically (horizontally) into n subrectangles+divide :: Alignment -> Orientation -> [D -> D] -> Rectangle -> [Rectangle]+divide _ _ [] _ = []+divide al _ [bh] (Rectangle sx sy sw sh) = [Rectangle (align al sx sw w) (align al sy sh h) w h]+    where+    (w, h) = bh (sw, sh)++divide al Tall (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle (align al sx sw w) sy w h) :+      (divide al Tall bhs (Rectangle sx (sy + fromIntegral h) sw (sh - h)))+ where+    (w, h) = bh (sw, sh `div` fromIntegral (1 + (length bhs)))++divide al Wide (bh:bhs) (Rectangle sx sy sw sh) = (Rectangle sx (align al sy sh h) w h) :+      (divide al Wide bhs (Rectangle (sx + fromIntegral w) sy (sw - w) sh))+ where+    (w, h) = bh (sw `div` fromIntegral (1 + (length bhs)), sh)++-- Split the screen into two rectangles, using a rational to specify the ratio+split :: Orientation -> Rational -> Rectangle -> (Rectangle -> [Rectangle])+      -> (Rectangle -> [Rectangle]) -> [Rectangle]+split Tall f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects+ where+    leftw = floor $ fromIntegral sw * f+    leftRects = left $ Rectangle sx sy leftw sh+    rightx = (maximum . map rect_width) leftRects+    rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh++split Wide f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects+ where+    toph = floor $ fromIntegral sh * f+    topRects = top $ Rectangle sx sy sw toph+    bottomy = (maximum . map rect_height) topRects+    bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)
+ XMonad/Layout/IM.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.IM+-- Copyright   :  (c) Roman Cheplyaka, Ivan N. Veselov <veselov@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modfier suitable for workspace with multi-windowed instant messanger+-- (like Psi or Tkabber).+--+-----------------------------------------------------------------------------++module XMonad.Layout.IM (+    -- * Usage+    -- $usage++    -- * Hints+    -- $hints++    -- * TODO+    -- $todo+        Property(..), IM(..), withIM, gridIM,+) where++import XMonad+import qualified XMonad.StackSet as S+import Data.List+import XMonad.Layout (splitHorizontallyBy)+import XMonad.Layout.Grid+import XMonad.Layout.LayoutModifier+import XMonad.Util.WindowProperties++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.IM+-- > import Data.Ratio ((%))+--+-- Then edit your @layoutHook@ by adding IM modifier to layout which you prefer+-- for managing your chat windows (Grid in this example, another useful choice+-- to consider is Tabbed layout).+--+-- > myLayouts = withIM (1%7) (ClassName "Tkabber") Grid ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- Here @1%7@ is the part of the screen which your roster will occupy,+-- @ClassName \"Tkabber\"@ tells xmonad which window is actually your roster.+--+-- Screenshot: <http://haskell.org/haskellwiki/Image:Xmonad-layout-im.png>+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- $hints+--+-- To launch IM layout automatically on your IM workspace use "XMonad.Layout.PerWorkspace".+--+-- By default the roster window will appear on the left side.+-- To place roster window on the right side, use @reflectHoriz@ from+-- "XMonad.Layout.Reflect" module.++-- $todo+-- This item are questionable. Please let me know if you find them useful.+--+-- * shrink\/expand+--++-- | Data type for LayoutModifier which converts given layout to IM-layout+-- (with dedicated space for the roster and original layout for chat windows)+data AddRoster a = AddRoster Rational Property deriving (Read, Show)++instance LayoutModifier AddRoster Window where+  modifyLayout (AddRoster ratio prop) = applyIM ratio prop+  modifierDescription _                = "IM"++-- | Modifier which converts given layout to IM-layout (with dedicated+-- space for roster and original layout for chat windows)+withIM :: LayoutClass l a => Rational -> Property -> l a -> ModifiedLayout AddRoster l a+withIM ratio prop = ModifiedLayout $ AddRoster ratio prop++-- | IM layout modifier applied to the Grid layout+gridIM :: Rational -> Property -> ModifiedLayout AddRoster Grid a+gridIM ratio prop = withIM ratio prop Grid++-- | Internal function for adding space for the roster specified by+-- the property and running original layout for all chat windows+applyIM :: (LayoutClass l Window) =>+               Rational+            -> Property+            -> S.Workspace WorkspaceId (l Window) Window+            -> Rectangle+            -> X ([(Window, Rectangle)], Maybe (l Window))+applyIM ratio prop wksp rect = do+    let stack = S.stack wksp+    let ws = S.integrate' $ stack+    let (masterRect, slaveRect) = splitHorizontallyBy ratio rect+    master <- findM (hasProperty prop) ws+    case master of+        Just w -> do+            let filteredStack = stack >>= S.filter (w /=)+            wrs <- runLayout (wksp {S.stack = filteredStack}) slaveRect+            return ((w, masterRect) : fst wrs, snd wrs)+        Nothing -> runLayout wksp rect++-- | Like find, but works with monadic computation instead of pure function.+findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)+findM _ [] = return Nothing+findM f (x:xs) = do { b <- f x; if b then return (Just x) else findM f xs }++-- | This is for compatibility with old configs only and will be removed in future versions!+data IM a = IM Rational Property deriving (Read, Show)+instance LayoutClass IM Window where+    description _ = "IM"+    doLayout (IM r prop) rect stack = do+        let ws = S.integrate stack+        let (masterRect, slaveRect) = splitHorizontallyBy r rect+        master <- findM (hasProperty prop) ws+        let positions = case master of+                Just w -> (w, masterRect) : arrange defaultRatio slaveRect (filter (w /=) ws)+                Nothing -> arrange defaultRatio rect ws+        return (positions, Nothing)
+ XMonad/Layout/IndependentScreens.hs view
@@ -0,0 +1,104 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.IndependentScreens+-- Copyright   :  (c) 2009 Daniel Wagner+-- License     :  BSD3+--+-- Maintainer  :  <daniel@wagner-home.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Utility functions for simulating independent sets of workspaces on+-- each screen (like dwm's workspace model), using internal tags to+-- distinguish workspaces associated with each screen.+-----------------------------------------------------------------------------++module XMonad.Layout.IndependentScreens (+    -- * Usage+    -- $usage+    VirtualWorkspace, PhysicalWorkspace,+    workspaces',+    withScreens, onCurrentScreen,+    countScreens,+    marshall, unmarshall+) where++-- for the screen stuff+import Control.Arrow hiding ((|||))+import Control.Monad+import Control.Monad.Instances+import Data.List+import Graphics.X11.Xinerama+import XMonad+import XMonad.StackSet hiding (workspaces)++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.IndependentScreens+--+-- You can define your workspaces by calling @withScreens@:+--+-- > myConfig = defaultConfig { workspaces = withScreens 2 ["web", "email", "irc"] }+--+-- This will create \"physical\" workspaces with distinct internal names for+-- each (screen, virtual workspace) pair.+--+-- Then edit any keybindings that use the list of workspaces or refer+-- to specific workspace names.  In the default configuration, only+-- the keybindings for changing workspace do this:+--+-- > [((m .|. modMask, k), windows $ f i)+-- >     | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]+-- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+--+-- This should change to+--+-- > [((m .|. modMask, k), windows $ onCurrentScreen f i)+-- >     | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]+-- >     , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]+--+-- In particular, the analogue of @XMonad.workspaces@ is+-- @workspaces'@, and you can use @onCurrentScreen@ to convert functions+-- of virtual workspaces to functions of physical workspaces, which work+-- by marshalling the virtual workspace name and the currently focused+-- screen into a physical workspace name.++type VirtualWorkspace  = WorkspaceId+type PhysicalWorkspace = WorkspaceId++marshall :: ScreenId -> VirtualWorkspace -> PhysicalWorkspace+marshall (S sc) vws = show sc ++ '_':vws++unmarshall :: PhysicalWorkspace -> (ScreenId, VirtualWorkspace)+unmarshall = ((S . read) *** drop 1) . break (=='_')++-- ^ You shouldn't need to use @marshall@ and @unmarshall@ very much.+-- They simply convert between the physical and virtual worlds.  For+-- example, you might want to use them as part of a status bar+-- configuration.  The function @snd . unmarshall@ would discard the+-- screen information from an otherwise unsightly workspace name.++workspaces' :: XConfig l -> [VirtualWorkspace]+workspaces' = nub . map (snd . unmarshall) . workspaces++withScreens :: ScreenId            -- ^ The number of screens to make workspaces for+            -> [VirtualWorkspace]  -- ^ The desired virtual workspace names+            -> [PhysicalWorkspace] -- ^ A list of all internal physical workspace names+withScreens n vws = [marshall sc pws | pws <- vws, sc <- [0..n-1]]++onCurrentScreen :: (VirtualWorkspace -> WindowSet -> a) -> (PhysicalWorkspace -> WindowSet -> a)+onCurrentScreen f vws = screen . current >>= f . flip marshall vws++-- | In case you don't know statically how many screens there will be, you can call this in main before starting xmonad.  For example, part of my config reads+--+-- > main = do+-- >   nScreens <- countScreens+-- >   xmonad $ defaultConfig {+-- >     ...+-- >     workspaces = withScreens nScreens (workspaces defaultConfig),+-- >     ...+-- >     }+--+countScreens :: (MonadIO m, Integral i) => m i+countScreens = liftM genericLength . liftIO $ openDisplay "" >>= getScreenInfo
+ XMonad/Layout/LayoutBuilder.hs view
@@ -0,0 +1,277 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.LayoutBuilder+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout combinator that sends a specified number of windows to one rectangle+-- and the rest to another.+--+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutBuilder (+  -- * Usage+  -- $usage+  layoutN,+  layoutR,+  layoutAll,+  IncLayoutN (..),+  SubMeasure (..),+  SubBox (..),+  absBox,+  relBox+) where++import XMonad+import XMonad.Layout+import qualified XMonad.StackSet as W+import Graphics.X11.Xlib+import Data.Maybe (isJust)+import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.LayoutBuilder+--+-- Then edit your @layoutHook@ by adding something like:+--+-- > myLayouts = ( (layoutN 1 (relBox 0 0 0.5 1) (Just $ relBox 0 0 1 1) $ simpleTabbed)+-- >             $ (layoutAll (relBox 0.5 0 1 1)                         $ simpleTabbed)+-- >             ) |||+-- >             ( (layoutN 1       (relBox (1/3) 0 (1/2) 1) (Just $ relBox 0 0 1 1) $ Tall 0 0 0)+-- >             $ (layoutR 0.1 0.5 (relBox (2/3) 0 1     1) Nothing                 $ Tall 0 0 0)+-- >             $ (layoutAll       (relBox 0     0 (1/3) 1)                         $ Tall 0 0 0)+-- >             ) |||+-- >             ( (layoutN 1 (absBox (-512-200) 0 512        0) (Just $ relBox 0 0 1 1) $ simpleTabbed)+-- >             $ (layoutN 1 (absBox (-200)     0 0          0) Nothing                 $ simpleTabbed)+-- >             $ (layoutAll (absBox 0          0 (-512-200) 0)                         $ simpleTabbed)+-- >             ) ||| Full ||| etc... +-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- This will produce a layout similar to DragPane, but with the possibility to have multiple windows in the left half+-- and tabs that show the available windows. It will also produce a layout similar to ThreeColMid and a special layout+-- created for use with a 80 columns wide Emacs window, its sidebar and a tabbed area for all other windows.+--+-- This module can be used to create many different custom layouts, but there are limitations. The primary limitation+-- can be observed in the second and third example when there are only two columns with windows in them. The leftmost+-- area is left blank. These blank areas can be avoided by placing the rectangles appropriately.+--+-- These examples require "XMonad.Layout.Tabbed".+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You may wish to add the following keybindings:+--+-- >    , ((modMask x .|. shiftMask, xK_h ), sendMessage $ IncLayoutN (-1))+-- >    , ((modMask x .|. shiftMask, xK_l ), sendMessage $ IncLayoutN 1)+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++type WindowNum = Either Int (Rational,Rational)++-- | Use one layout in the specified area for a number of windows and possibly let another layout handle the rest.+data LayoutN l1 l2 a =+    LayoutN (Maybe a) (Maybe a) WindowNum SubBox (Maybe SubBox) (l1 a) (Maybe (l2 a))+    deriving (Show,Read)++-- | Use the specified layout in the described area for N windows and send the rest of the windows to the next layout in the chain.+--   It is possible to supply an alternative area that will then be used instead, if there are no windows to send to the next layout.+layoutN :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>+       Int                          -- ^ The number of windows to handle+    -> SubBox                       -- ^ The box to place the windows in+    -> Maybe SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left+    -> l1 a                         -- ^ The layout to use in the specified area+    -> LayoutN l2 l3 a              -- ^ Where to send the remaining windows+    -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout+layoutN num box mbox sub next = LayoutN Nothing Nothing (Left num) box mbox sub (Just next)++-- | As layoutN, but the number of windows is given relative to the total number of windows remaining to be handled. The first+--   argument is how much to change the ratio when using IncLayoutN, and the second is the initial ratio.+layoutR :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a) =>+       Rational                     -- ^ How much to change the ratio with each IncLayoutN+    -> Rational                     -- ^ The ratio of the remaining windows to handle+    -> SubBox                       -- ^ The box to place the windows in+    -> Maybe SubBox                 -- ^ Possibly an alternative box that is used when this layout handles all windows that are left+    -> l1 a                         -- ^ The layout to use in the specified area+    -> LayoutN l2 l3 a              -- ^ Where to send the remaining windows+    -> LayoutN l1 (LayoutN l2 l3) a -- ^ The resulting layout+layoutR numdiff num box mbox sub next = LayoutN Nothing Nothing (Right (numdiff,num)) box mbox sub (Just next)++-- | Use the specified layout in the described area for all remaining windows.+layoutAll :: (Read a, Eq a, LayoutClass l1 a) =>+       SubBox             -- ^ The box to place the windows in+    -> l1 a               -- ^ The layout to use in the specified area+    -> LayoutN l1 Full a  -- ^ The resulting layout+layoutAll box sub = LayoutN Nothing Nothing (Right (0,1)) box Nothing sub Nothing++-- | Change the number of windows handled by the focused layout.+data IncLayoutN = IncLayoutN Int deriving Typeable+instance Message IncLayoutN++-- | The absolute or relative measures used to describe the area a layout should be placed in. For negative absolute values+--   the total remaining space will be added. For sizes, the remaining space will also be added for zeroes. Relative values+--   are applied on the remaining space after the top-left corner of the box have been removed.+data SubMeasure = Abs Int | Rel Rational deriving (Show,Read)++-- | A box to place a layout in. The stored values are xpos, ypos, width and height.+data SubBox = SubBox SubMeasure SubMeasure SubMeasure SubMeasure deriving (Show,Read)+++-- | Create a box with only absolute measurements. If the values are negative, the total remaining space will be added. For+--   sizes it will also be added for zeroes.+absBox :: Int     -- ^ Absolute X-Position+       -> Int     -- ^ Absolute Y-Position+       -> Int     -- ^ Absolute width+       -> Int     -- ^ Absolute height+       -> SubBox  -- ^ The resulting 'SubBox' describing the area+absBox x y w h = SubBox (Abs x) (Abs y) (Abs w) (Abs h)+++-- | Create a box with only relative measurements.+relBox :: Rational  -- ^ Relative X-Position with respect to the surrounding area+       -> Rational  -- ^ Relative Y-Position with respect to the surrounding area+       -> Rational  -- ^ Relative width with respect to the remaining width+       -> Rational  -- ^ Relative height with respect to the remaining height+       -> SubBox    -- ^ The resulting 'SubBox' describing the area+relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h)+++instance (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) =>+    LayoutClass (LayoutN l1 l2) a where++        -- | Update window locations.+        runLayout (W.Workspace _ (LayoutN subf nextf num box mbox sub next) s) rect+            = do let (subs,nexts,subf',nextf') = splitStack s num subf nextf+                     selBox = if isJust nextf'+                              then box+                              else maybe box id mbox++                 (sublist,sub') <- handle sub subs $ calcArea selBox rect++                 (nextlist,next') <- case next of Nothing -> return ([],Nothing)+                                                  Just n -> do (res,l) <- handle n nexts rect+                                                               return (res,Just l)++                 return (sublist++nextlist, Just $ LayoutN subf' nextf' num box mbox sub' next' )+              where+                  handle l s' r = do (res,ml) <- runLayout (W.Workspace "" l s') r+                                     l' <- return $ maybe l id ml+                                     return (res,l')++        -- |  Propagate messages.+        handleMessage l m+            | Just (IncLayoutN _) <- fromMessage m = windowNum l m+            | Just (IncMasterN _) <- fromMessage m = sendFocus l m+            | Just (Shrink) <- fromMessage m = sendFocus l m+            | Just (Expand) <- fromMessage m = sendFocus l m+            | otherwise = sendBoth l m++        -- |  Descriptive name for layout.+        description (LayoutN _ _ _ _ _ sub Nothing) = "layoutAll "++ description sub+        description (LayoutN _ _ (Left _) _ _ sub (Just next)) = "layoutN "++ description sub ++" "++ description next+        description (LayoutN _ _ (Right _) _ _ sub (Just next)) = "layoutR "++ description sub ++" "++ description next+++windowNum :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a))+windowNum l@(LayoutN subf nextf num box mbox subl nextl) m | (Just (IncLayoutN n)) <- fromMessage m =+    do foc <- isFocus subf+       if foc then do let newnum = case num of+                                       (Left oldnum) -> Left $ max 1 $ oldnum + n+                                       (Right (diff,oldnum)) -> Right (diff, min 1 $ max 0 $ oldnum + (fromIntegral n)*diff)+                      return $ Just $ LayoutN subf nextf newnum box mbox subl nextl+              else sendNext l m+windowNum l m = sendNext l m++sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a))+sendSub (LayoutN subf nextf num box mbox sub next) m =+    do sub' <- handleMessage sub m+       return $ if isJust sub'+                then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') next+                else Nothing++sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a))+sendBoth l@(LayoutN _ _ _ _ _ _ Nothing) m = sendSub l m+sendBoth (LayoutN subf nextf num box mbox sub (Just next)) m =+    do sub' <- handleMessage sub m+       next' <- handleMessage next m+       return $ if isJust sub' || isJust next'+                then Just $ LayoutN subf nextf num box mbox (maybe sub id sub') (Just $ maybe next id next')+                else Nothing++sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a))+sendNext (LayoutN _ _ _ _ _ _ Nothing) _ = return Nothing+sendNext (LayoutN subf nextf num box mbox sub (Just next)) m =+    do next' <- handleMessage next m+       return $ if isJust next'+                then Just $ LayoutN subf nextf num box mbox sub next'+                else Nothing++sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a) => LayoutN l1 l2 a -> SomeMessage -> X (Maybe (LayoutN l1 l2 a))+sendFocus l@(LayoutN subf _ _ _ _ _ _) m = do foc <- isFocus subf+                                              if foc then sendSub l m+                                                     else sendNext l m++isFocus :: (Show a) => Maybe a -> X Bool+isFocus Nothing = return False+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset+                      return $ maybe False (\s -> show w == (show $ W.focus s)) ms+++calcNum :: Int -> WindowNum -> Int+calcNum tot num = max 1 $ case num of Left i -> i+                                      Right (_,r) -> ceiling $ r * fromIntegral tot++splitStack :: Eq a => Maybe (W.Stack a) -> WindowNum -> Maybe a -> Maybe a -> (Maybe (W.Stack a),Maybe (W.Stack a),Maybe a,Maybe a)+splitStack Nothing _ _ _ = (Nothing,Nothing,Nothing,Nothing)+splitStack (Just s) num subf nextf = ( differentiate' subf' subl+                                     , differentiate' nextf' nextl+                                     , subf'+                                     , nextf'+                                     )+    where+        ws = W.integrate s+        n = calcNum (length ws) num+        subl = take n ws+        nextl = drop n ws+        subf' = foc subl subf+        nextf' = foc nextl nextf+        foc [] _ = Nothing+        foc l f = if W.focus s `elem` l+                  then Just $ W.focus s+                  else if maybe False (`elem` l) f+                       then f+                       else Just $ head l++calcArea :: SubBox -> Rectangle -> Rectangle+calcArea (SubBox xpos ypos width height) rect = Rectangle (rect_x rect + fromIntegral xpos') (rect_y rect + fromIntegral ypos') width' height'+    where+        xpos' = calc False xpos $ rect_width rect+        ypos' = calc False ypos $ rect_height rect+        width' = calc True width $ rect_width rect - xpos'+        height' = calc True height $ rect_height rect - ypos'++        calc zneg val tot = fromIntegral $ min (fromIntegral tot) $ max 0 $+            case val of Rel v -> floor $ v * fromIntegral tot+                        Abs v -> if v<0 || (zneg && v==0)+                                 then (fromIntegral tot)+v+                                 else v++differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)+differentiate' _ [] = Nothing+differentiate' Nothing w = W.differentiate w+differentiate' (Just f) w+    | f `elem` w = Just $ W.Stack { W.focus = f+                                  , W.up    = reverse $ takeWhile (/=f) w+                                  , W.down  = tail $ dropWhile (/=f) w+                                  }+    | otherwise = W.differentiate w
+ XMonad/Layout/LayoutCombinators.hs view
@@ -0,0 +1,280 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.LayoutCombinators+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : none+-- Stability    : unstable+-- Portability  : portable+--+-- The "XMonad.Layout.LayoutCombinators" module provides combinators+-- for easily combining multiple layouts into one composite layout, as+-- well as a way to jump directly to any particular layout (say, with+-- a keybinding) without having to cycle through other layouts to get+-- to it.+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutCombinators+    ( -- * Usage+      -- $usage++      -- * Layout combinators+      -- $combine++      -- ** Combinators using DragPane vertical+      -- $dpv+      (*||*), (**||*),(***||*),(****||*),(***||**),(****||***)+    , (***||****),(*||****),(**||***),(*||***),(*||**)++      -- ** Combinators using DragPane horizontal+      -- $dph+    , (*//*), (**//*),(***//*),(****//*),(***//**),(****//***)+    , (***//****),(*//****),(**//***),(*//***),(*//**)++      -- ** Combinators using Tall (vertical)+      -- $tv+    , (*|*), (**|*),(***|*),(****|*),(***|**),(****|***)+    , (***|****),(*|****),(**|***),(*|***),(*|**)++      -- ** Combinators using Mirror Tall (horizontal)+      -- $mth+    , (*/*), (**/*),(***/*),(****/*),(***/**),(****/***)+    , (***/****),(*/****),(**/***),(*/***),(*/**)++      -- * New layout choice combinator and 'JumpToLayout'+      -- $jtl+    , (|||)+    , JumpToLayout(JumpToLayout)+    ) where++import Data.Maybe ( isJust, isNothing )++import XMonad hiding ((|||))+import XMonad.StackSet (Workspace (..))+import XMonad.Layout.Combo+import XMonad.Layout.DragPane++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.LayoutCombinators hiding ( (|||) )+--+-- Then edit your @layoutHook@ to use the new layout combinators. For+-- example:+--+-- > myLayouts = (Tall 1 (3/100) (1/2) *//* Full)  ||| (Tall 1 (3/100) (1/2) ***||** Full) ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the @layoutHook@ see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- To use the 'JumpToLayout' message, hide the normal @|||@ operator instead:+--+-- > import XMonad hiding ( (|||) )+-- > import XMonad.Layout.LayoutCombinators+--+-- Then bind some keys to a 'JumpToLayout' message:+--+-- >   , ((modMask x .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")  -- jump directly to the Full layout+--+-- See below for more detailed documentation.++-- $combine+-- Each of the following combinators combines two layouts into a+-- single composite layout by splitting the screen into two regions,+-- one governed by each layout.  Asterisks in the combinator names+-- denote the relative amount of screen space given to the respective+-- layouts.  For example, the '***||*' combinator gives three times as+-- much space to the left-hand layout as to the right-hand layout.++infixr 6 *||*, **||*, ***||*, ****||*, ***||**, ****||***, ***||****, *||****, **||***, *||***, *||**,+         *//*, **//*, ***//*, ****//*, ***//**, ****//***, ***//****, *//****, **//***, *//***, *//**,+         *|* , **|* , ***|* , ****|* , ***|** , ****|*** , ***|**** , *|**** , **|*** , *|*** , *|** ,+         */* , **/* , ***/* , ****/* , ***/** , ****/*** , ***/**** , */**** , **/*** , */*** , */**++-- $dpv+-- These combinators combine two layouts using "XMonad.DragPane" in+-- vertical mode.++(*||*),(**||*),(***||*),(****||*), (***||**),(****||***),+       (***||****),(*||****),(**||***),(*||***),(*||**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>+          l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a++(*||*)      = combineTwo (dragPane Vertical 0.1 (1/2))+(**||*)     = combineTwo (dragPane Vertical 0.1 (2/3))+(***||*)    = combineTwo (dragPane Vertical 0.1 (3/4))+(****||*)   = combineTwo (dragPane Vertical 0.1 (4/5))+(***||**)   = combineTwo (dragPane Vertical 0.1 (3/5))+(****||***) = combineTwo (dragPane Vertical 0.1 (4/7))+(***||****) = combineTwo (dragPane Vertical 0.1 (3/7))+(*||****)   = combineTwo (dragPane Vertical 0.1 (1/5))+(**||***)   = combineTwo (dragPane Vertical 0.1 (2/5))+(*||***)    = combineTwo (dragPane Vertical 0.1 (1/4))+(*||**)     = combineTwo (dragPane Vertical 0.1 (1/3))++-- $dph+-- These combinators combine two layouts using "XMonad.DragPane" in+-- horizontal mode.++(*//*),(**//*),(***//*),(****//*), (***//**),(****//***),+       (***//****),(*//****),(**//***),(*//***),(*//**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a) =>+          l1 a -> l2 a -> CombineTwo (DragPane ()) l1 l2 a++(*//*)      = combineTwo (dragPane Horizontal 0.1 (1/2))+(**//*)     = combineTwo (dragPane Horizontal 0.1 (2/3))+(***//*)    = combineTwo (dragPane Horizontal 0.1 (3/4))+(****//*)   = combineTwo (dragPane Horizontal 0.1 (4/5))+(***//**)   = combineTwo (dragPane Horizontal 0.1 (3/5))+(****//***) = combineTwo (dragPane Horizontal 0.1 (4/7))+(***//****) = combineTwo (dragPane Horizontal 0.1 (3/7))+(*//****)   = combineTwo (dragPane Horizontal 0.1 (1/5))+(**//***)   = combineTwo (dragPane Horizontal 0.1 (2/5))+(*//***)    = combineTwo (dragPane Horizontal 0.1 (1/4))+(*//**)     = combineTwo (dragPane Horizontal 0.1 (1/3))++-- $tv+-- These combinators combine two layouts vertically using @Tall@.++(*|*),(**|*),(***|*),(****|*), (***|**),(****|***),+       (***|****),(*|****),(**|***),(*|***),(*|**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)+          => l1 a -> l2 a -> CombineTwo (Tall ()) l1 l2 a+(*|*)      = combineTwo (Tall 1 0.1 (1/2))+(**|*)     = combineTwo (Tall 1 0.1 (2/3))+(***|*)    = combineTwo (Tall 1 0.1 (3/4))+(****|*)   = combineTwo (Tall 1 0.1 (4/5))+(***|**)   = combineTwo (Tall 1 0.1 (3/5))+(****|***) = combineTwo (Tall 1 0.1 (4/7))+(***|****) = combineTwo (Tall 1 0.1 (3/7))+(*|****)   = combineTwo (Tall 1 0.1 (1/5))+(**|***)   = combineTwo (Tall 1 0.1 (2/5))+(*|***)    = combineTwo (Tall 1 0.1 (1/4))+(*|**)     = combineTwo (Tall 1 0.1 (1/3))+++-- $mth+-- These combinators combine two layouts horizontally using @Mirror+-- Tall@.++(*/*),(**/*),(***/*),(****/*), (***/**),(****/***),+       (***/****),(*/****),(**/***),(*/***),(*/**) :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a)+          => l1 a -> l2 a -> CombineTwo (Mirror Tall ()) l1 l2 a+(*/*)      = combineTwo (Mirror $ Tall 1 0.1 (1/2))+(**/*)     = combineTwo (Mirror $ Tall 1 0.1 (2/3))+(***/*)    = combineTwo (Mirror $ Tall 1 0.1 (3/4))+(****/*)   = combineTwo (Mirror $ Tall 1 0.1 (4/5))+(***/**)   = combineTwo (Mirror $ Tall 1 0.1 (3/5))+(****/***) = combineTwo (Mirror $ Tall 1 0.1 (4/7))+(***/****) = combineTwo (Mirror $ Tall 1 0.1 (3/7))+(*/****)   = combineTwo (Mirror $ Tall 1 0.1 (1/5))+(**/***)   = combineTwo (Mirror $ Tall 1 0.1 (2/5))+(*/***)    = combineTwo (Mirror $ Tall 1 0.1 (1/4))+(*/**)     = combineTwo (Mirror $ Tall 1 0.1 (1/3))++infixr 5 |||++-- $jtl+-- The standard xmonad core exports a layout combinator @|||@ which+-- represents layout choice.  This is a reimplementation which also+-- provides the capability to support 'JumpToLayout' messages.  To use+-- it, be sure to hide the import of @|||@ from the xmonad core:+--+-- > import XMonad hiding ( (|||) )+--+-- The argument given to a 'JumpToLayout' message should be the+-- @description@ of the layout to be selected.  If you use+-- "XMonad.Hooks.DynamicLog", this is the name of the layout displayed+-- in your status bar.  Alternatively, you can use GHCi to determine+-- the proper name to use.  For example:+--+-- > $ ghci+-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/  :? for help+-- > Loading package base ... linking ... done.+-- > :set prompt "> "    -- don't show loaded module names+-- > > :m +XMonad.Core   -- load the xmonad core+-- > > :m +XMonad.Layout.Grid  -- load whatever module you want to use+-- > > description Grid  -- find out what it's called+-- > "Grid"+--+-- As yet another (possibly easier) alternative, you can use the+-- "XMonad.Layout.Named" modifier to give custom names to your+-- layouts, and use those.+--+-- For the ability to select a layout from a prompt, see+-- "Xmonad.Prompt.Layout".++-- | A reimplementation of the combinator of the same name from the+--   xmonad core, providing layout choice, and the ability to support+--   'JumpToLayout' messages.+(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a+(|||) = NewSelect True++data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show )++data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable )+instance Message NoWrap++-- | A message to jump to a particular layout, specified by its+--   description string.+data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable )+instance Message JumpToLayout++instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where+    runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r+                                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')++    runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r+                                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')+    description (NewSelect True l1 _) = description l1+    description (NewSelect False _ l2) = description l2+    handleMessage l@(NewSelect False _ _) m+        | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m+    handleMessage l@(NewSelect amfirst _ _) m+        | Just NextLayoutNoWrap <- fromMessage m =+                  if amfirst then when' isNothing (passOnM m l) $+                                  fmap Just $ swap l >>= passOn (SomeMessage Wrap)+                             else passOnM m l+    handleMessage l m+        | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $+                                             fmap Just $ swap l >>= passOn (SomeMessage Wrap)+    handleMessage l@(NewSelect True _ l2) m+        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l+    handleMessage l@(NewSelect False l1 _) m+        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l+    handleMessage l m+        | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $+                                                   do ml' <- passOnM m $ sw l+                                                      case ml' of+                                                        Nothing -> return Nothing+                                                        Just l' -> Just `fmap` swap (sw l')+    handleMessage (NewSelect b l1 l2) m+        | Just ReleaseResources  <- fromMessage m =+        do ml1' <- handleMessage l1 m+           ml2' <- handleMessage l2 m+           return $ if isJust ml1' || isJust ml2'+                    then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')+                    else Nothing+    handleMessage l m = passOnM m l++swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)+swap l = sw `fmap` passOn (SomeMessage Hide) l++sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a+sw (NewSelect b lt lf) = NewSelect (not b) lt lf++passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>+          SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)+passOn m l = maybe l id `fmap` passOnM m l++passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>+           SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))+passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m+                                      return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'+passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m+                                       return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'++when' :: Monad m => (a -> Bool) -> m a -> m a -> m a+when' f a b = do a1 <- a; if f a1 then b else return a1
+ XMonad/Layout/LayoutHints.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module       : XMonad.Layout.LayoutHints+-- Copyright    : (c) David Roundy <droundy@darcs.net>+-- License      : BSD+--+-- Maintainer   : none+-- Stability    : unstable+-- Portability  : portable+--+-- Make layouts respect size hints.+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutHints+    ( -- * usage+      -- $usage+      layoutHints+    , layoutHintsWithPlacement+    , LayoutHints+    , placeRectangle+    ) where++import XMonad hiding ( trace )+import XMonad.Layout.LayoutModifier+import XMonad.Layout.Decoration ( isInStack )++import Control.Applicative ( (<$>) )+import Control.Arrow ( second )++-- $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 }+--+-- Or, to center the adapted window in its available area:+--+-- > myLayouts = layoutHintsWithPlacement (0.5, 0.5) (Tall 1 (3/100) (1/2))  +-- >                   ||| Full ||| etc..+--+-- 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 (0, 0))++-- | @layoutHintsWithPlacement (rx, ry) layout@ will adapt the sizes of a layout's+-- windows according to their size hints, and position them inside their+-- originally assigned area according to the @rx@ and @ry@ parameters.+-- (0, 0) places the window at the top left, (1, 0) at the top right, (0.5, 0.5)+-- at the center, etc.+layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) +                         -> l a -> ModifiedLayout LayoutHints l a+layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs)++data LayoutHints a = LayoutHints (Double, Double) +                     deriving (Read, Show)++instance LayoutModifier LayoutHints Window where+    modifierDescription _ = "Hinted"+    redoLayout _ _ Nothing  xs = return (xs, Nothing)+    redoLayout (LayoutHints al) _ (Just s) xs +        = do xs' <- mapM (\x@(_, r) -> second (placeRectangle al r) <$> applyHint x) xs+             return (xs', Nothing)+     where+        applyHint (w,r@(Rectangle a b c d)) = do+            adj <- mkAdjust w+            let (c',d') = adj (c,d)+            return (w, if isInStack s w then Rectangle a b c' d' else r)++-- | @placeRectangle (rx, ry) r0 r@ will return a new rectangle with the same dimensions+-- as @r@, but positioned inside of @r0@ as specified by the (rx, ry) parameters (see +-- 'layoutHintsWithPlacement').+placeRectangle :: RealFrac r => (r, r) -> Rectangle -> Rectangle -> Rectangle+placeRectangle (rx, ry) (Rectangle x0 y0 w h) (Rectangle _ _ dx dy)+    = Rectangle (align x0 dx w rx) (align y0 dy h ry) dx dy+    where align :: RealFrac r => Position -> Dimension -> Dimension -> r -> Position+          align z0 dz d r = z0 + truncate (fromIntegral (d - dz) * r)
+ XMonad/Layout/LayoutModifier.hs view
@@ -0,0 +1,263 @@+{-# 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   : none+-- Stability    : unstable+-- Portability  : portable+--+-- A module for writing easy layout modifiers, which do not define a+-- layout in and of themselves, but modify the behavior of or add new+-- functionality to other layouts.  If you ever find yourself writing+-- a layout which takes another layout as a parameter, chances are you+-- should be writing a LayoutModifier instead!+--+-- In case it is not clear, this module is not intended to help you+-- configure xmonad, it is to help you write other extension modules.+-- So get hacking!+-----------------------------------------------------------------------------++module XMonad.Layout.LayoutModifier (+    -- * Usage+    -- $usage++    -- * The 'LayoutModifier' class+    LayoutModifier(..), ModifiedLayout(..)+    ) where++import XMonad+import XMonad.StackSet ( Stack, Workspace (..) )++-- $usage+--+-- The 'LayoutModifier' class is provided to help extension developers+-- write easy layout modifiers.  End users won't find much of interest+-- here. =)+--+-- To write a layout modifier using the 'LayoutModifier' class, define+-- a data type to represent the layout modification (storing any+-- necessary state), define an instance of 'LayoutModifier', and+-- export an appropriate function for applying the modifier.  For example:+--+-- > data MyModifier a = MyModifier MyState+-- >   deriving (Show, Read)+-- >+-- > instance LayoutModifier MyModifier a where+-- >   -- override whatever methods from LayoutModifier you like+-- >+-- > modify :: l a -> ModifiedLayout MyModifier l a+-- > modify = ModifiedLayout (MyModifier initialState)+--+-- When defining an instance of 'LayoutModifier', you are free to+-- override as many or as few of the methods as you see fit.  See the+-- documentation below for specific information about the effect of+-- overriding each method.  Every method has a default implementation;+-- an instance of 'LayoutModifier' which did not provide a non-default+-- implementation of any of the methods would simply act as the+-- identity on any layouts to which it is applied.+--+-- For more specific usage examples, see+--+-- * "XMonad.Layout.WorkspaceDir"+--+-- * "XMonad.Layout.Magnifier"+--+-- * "XMonad.Layout.NoBorders"+--+-- * "XMonad.Layout.Reflect"+--+-- * "XMonad.Layout.Named"+--+-- * "XMonad.Layout.WindowNavigation"+--+-- and several others.  You probably want to start by looking at some+-- of the above examples; the documentation below is detailed but+-- possibly confusing, and in many cases the creation of a+-- 'LayoutModifier' is actually quite simple.+--+-- /Important note/: because of the way the 'LayoutModifier' class is+-- intended to be used, by overriding any of its methods and keeping+-- default implementations for all the others, 'LayoutModifier'+-- methods should never be called explicitly.  It is likely that such+-- explicit calls will not have the intended effect.  Rather, the+-- 'LayoutModifier' methods should only be called indirectly through+-- the 'LayoutClass' instance for 'ModifiedLayout', since it is this+-- instance that defines the semantics of overriding the various+-- 'LayoutModifier' methods.++class (Show (m a), Read (m a)) => LayoutModifier m a where++    -- | 'modifyLayout' allows you to intercept a call to 'runLayout'+    --   /before/ it is called on the underlying layout, in order to+    --   perform some effect in the X monad, and\/or modify some of+    --   the parameters before passing them on to the 'runLayout'+    --   method of the underlying layout.+    --+    --   The default implementation of 'modifyLayout' simply calls+    --   'runLayout' on the underlying layout.+    modifyLayout :: (LayoutClass l a) =>+                    m a                             -- ^ the layout modifier+                 -> Workspace WorkspaceId (l a) a   -- ^ current workspace+                 -> Rectangle                       -- ^ screen rectangle+                 -> X ([(a, Rectangle)], Maybe (l a))+    modifyLayout _ w r = runLayout w r++    -- | 'handleMess' allows you to spy on messages to the underlying+    --   layout, in order to have an effect in the X monad, or alter+    --   the layout modifier state in some way (by returning @Just+    --   nm@, where @nm@ is a new modifier).  In all cases, the+    --   underlying layout will also receive the message as usual,+    --   after the message has been processed by 'handleMess'.+    --+    --   If you wish to possibly modify a message before it reaches+    --   the underlying layout, you should use+    --   'handleMessOrMaybeModifyIt' instead.  If you do not need to+    --   modify messages or have access to the X monad, you should use+    --   'pureMess' instead.+    --+    --   The default implementation of 'handleMess' calls 'unhook'+    --   when receiving a 'Hide' or 'ReleaseResources' method (after+    --   which it returns @Nothing@), and otherwise passes the message+    --   on to 'pureMess'.+    handleMess :: m a -> SomeMessage -> X (Maybe (m a))+    handleMess m mess | Just Hide <- fromMessage mess             = doUnhook+                      | Just ReleaseResources <- fromMessage mess = doUnhook+                      | otherwise = return $ pureMess m mess+     where doUnhook = do unhook m; return Nothing++    -- | 'handleMessOrMaybeModifyIt' allows you to intercept messages+    --   sent to the underlying layout, in order to have an effect in+    --   the X monad, alter the layout modifier state, or produce a+    --   modified message to be passed on to the underlying layout.+    --+    --   The default implementation of 'handleMessOrMaybeModifyIt'+    --   simply passes on the message to 'handleMess'.+    handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))+    handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess+                                          return (Left `fmap` mm')++    -- | 'pureMess' allows you to spy on messages sent to the+    --   underlying layout, in order to possibly change the layout+    --   modifier state.+    --+    --   The default implementation of 'pureMess' ignores messages+    --   sent to it, and returns @Nothing@ (causing the layout+    --   modifier to remain unchanged).+    pureMess :: m a -> SomeMessage -> Maybe (m a)+    pureMess _ _ = Nothing++    -- | 'redoLayout' allows you to intercept a call to 'runLayout' on+    --   workspaces with at least one window, /after/ it is called on+    --   the underlying layout, in order to perform some effect in the+    --   X monad, possibly return a new layout modifier, and\/or+    --   modify the results of 'runLayout' before returning them.+    --+    --   If you don't need access to the X monad, use 'pureModifier'+    --   instead.  Also, if the behavior you need can be cleanly+    --   separated into an effect in the X monad, followed by a pure+    --   transformation of the results of 'runLayout', you should+    --   consider implementing 'hook' and 'pureModifier' instead of+    --   'redoLayout'.+    --+    --   On empty workspaces, the Stack is Nothing.+    --+    --   The default implementation of 'redoLayout' calls 'hook' and+    --   then 'pureModifier'.+    redoLayout :: m a               -- ^ the layout modifier+               -> Rectangle         -- ^ screen rectangle+               -> Maybe (Stack a)   -- ^ current window stack+               -> [(a, Rectangle)]  -- ^ (window,rectangle) pairs returned+                                    -- by the underlying layout+               -> X ([(a, Rectangle)], Maybe (m a))+    redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs++    -- | 'pureModifier' allows you to intercept a call to 'runLayout'+    --   /after/ it is called on the underlying layout, in order to+    --   modify the list of window\/rectangle pairings it has returned,+    --   and\/or return a new layout modifier.+    --+    --   The default implementation of 'pureModifier' returns the+    --   window rectangles unmodified.+    pureModifier :: m a               -- ^ the layout modifier+                 -> Rectangle         -- ^ screen rectangle+                 -> Maybe (Stack a)   -- ^ current window stack+                 -> [(a, Rectangle)]  -- ^ (window, rectangle) pairs returned+                                      -- by the underlying layout+                 -> ([(a, Rectangle)], Maybe (m a))+    pureModifier _ _ _ wrs = (wrs, Nothing)++    -- | 'hook' is called by the default implementation of+    --   'redoLayout', and as such represents an X action which is to+    --   be run each time 'runLayout' is called on the underlying+    --   layout, /after/ 'runLayout' has completed.  Of course, if you+    --   override 'redoLayout', then 'hook' will not be called unless+    --   you explicitly call it.+    --+    --   The default implementation of 'hook' is @return ()@ (i.e., it+    --   has no effect).+    hook :: m a -> X ()+    hook _ = return ()++    -- | 'unhook' is called by the default implementation of+    --   'handleMess' upon receiving a 'Hide' or a 'ReleaseResources'+    --   message.+    --+    --   The default implementation, of course, does nothing.+    unhook :: m a -> X ()+    unhook _ = return ()++    -- | 'modifierDescription' is used to give a String description to+    --   this layout modifier.  It is the empty string by default; you+    --   should only override this if it is important that the+    --   presence of the layout modifier be displayed in text+    --   representations of the layout (for example, in the status bar+    --   of a "XMonad.Hooks.DynamicLog" user).+    modifierDescription :: m a -> String+    modifierDescription = const ""++    -- | 'modifyDescription' gives a String description for the entire+    --   layout (modifier + underlying layout).  By default, it is+    --   derived from the concatenation of the 'modifierDescription'+    --   with the 'description' of the underlying layout, with a+    --   \"smart space\" in between (the space is not included if the+    --   'modifierDescription' is empty).+    modifyDescription :: (LayoutClass l a) => m a -> l a -> String+    modifyDescription m l = modifierDescription m <> description l+        where "" <> x = x+              x <> y = x ++ " " ++ y++-- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the+--   semantics of a 'LayoutModifier' applied to an underlying layout.+instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where+    runLayout (Workspace i (ModifiedLayout m l) ms) r =+        do (ws, ml')  <- modifyLayout m (Workspace i l ms) r+           (ws', mm') <- redoLayout m r ms ws+           let ml'' = case mm' of+                        Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'+                        Nothing -> ModifiedLayout m `fmap` ml'+           return (ws', ml'')++    handleMessage (ModifiedLayout m l) mess =+        do mm' <- handleMessOrMaybeModifyIt m mess+           ml' <- case mm' of+                  Just (Right mess') -> handleMessage l mess'+                  _ -> handleMessage l mess+           return $ case mm' of+                    Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'+                    _ -> (ModifiedLayout m) `fmap` ml'+    description (ModifiedLayout m l) = modifyDescription m l++-- | A 'ModifiedLayout' is simply a container for a layout modifier+--   combined with an underlying layout.  It is, of course, itself a+--   layout (i.e. an instance of 'LayoutClass').+data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )++-- N.B. I think there is a Haddock bug here; the Haddock output for+-- the above does not parenthesize (m a) and (l a), which is obviously+-- incorrect.+
+ XMonad/Layout/LayoutScreens.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.LayoutScreens+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- 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+-- > import XMonad.Layout.TwoPane+--+-- Then add some keybindings; for example:+--+-- >   , ((modMask x .|. shiftMask,                 xK_space), layoutScreens 2 (TwoPane 0.5 0.5))+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)+--+-- Another example use would be to handle a scenario where xrandr didn't+-- work properly (e.g. a VNC X server in my case) and you want to be able+-- to resize your screen (e.g. to match the size of a remote VNC client):+--+-- > import XMonad.Layout.LayoutScreens+--+-- >   , ((modMask x .|. shiftMask, xK_space),+-- >        layoutScreens 1 (fixedLayout [Rectangle 0 0 1024 768]))+-- >   , ((modMask x .|. controlMask .|. shiftMask, xK_space), rescreen)+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++layoutScreens :: 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, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect+       windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->+           let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs+               s:ss = map snd wss+           in  ws { W.current = W.Screen x 0 (SD s)+                  , W.visible = zipWith3 W.Screen xs [1 ..] $ map SD ss+                  , 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,91 @@+{-# 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,+     promoteWarp,+     promoteWarp'+    ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutModifier++import XMonad.Actions.UpdatePointer(updatePointer, PointerPosition(TowardsCentre))+import Data.Monoid(All(..))+import qualified Data.Map as M++-- $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,+-- >                               handleEventHook = promoteWarp }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | Create a new layout which automagically puts the focused window+--   in the master area.+magicFocus :: l a -> ModifiedLayout MagicFocus l a+magicFocus = ModifiedLayout MagicFocus++data MagicFocus a = MagicFocus deriving (Show, Read)++instance LayoutModifier MagicFocus Window where+  modifyLayout MagicFocus (W.Workspace i l s) r =+    withWindowSet $ \wset ->+      runLayout (W.Workspace i l (s >>= \st -> Just $ swap st (W.peek wset))) r++swap :: (Eq a) => W.Stack a -> Maybe a -> W.Stack a+swap (W.Stack f u d) focused+    | Just f == focused = W.Stack f [] (reverse u ++ d)+    | otherwise         = W.Stack f u d++-- | An eventHook that overrides the normal focusFollowsMouse. When the mouse+-- it moved to another window, that window is replaced as the master, and the+-- mouse is warped to inside the new master.+--+-- It prevents infinite loops when focusFollowsMouse is true (the default), and+-- MagicFocus is in use when changing focus with the mouse.+--+-- This eventHook does nothing when there are floating windows on the current+-- workspace.+promoteWarp :: Event -> X All+promoteWarp = promoteWarp' (TowardsCentre 0.15 0.15)++-- | promoteWarp' allows you to specify an arbitrary PointerPosition to apply+-- when the mouse enters another window.+promoteWarp' :: PointerPosition -> Event -> X All+promoteWarp' pos e@(CrossingEvent {ev_window = w, ev_event_type = t})+    | t == enterNotify && ev_mode   e == notifyNormal = do+        ws <- gets windowset+        let foc = W.peek ws+            st = W.integrate' . W.stack . W.workspace $ W.current ws+            wsFloats = M.filterWithKey (\k _ -> k `elem` st) $ W.floating ws+        if Just w /= foc && M.null wsFloats then do+            windows (W.swapMaster . W.focusWindow w)+            updatePointer pos+            return $ All False+          else return $ All True+promoteWarp' _ _ = return $ All True
+ XMonad/Layout/Magnifier.hs view
@@ -0,0 +1,164 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Magnifier+-- Copyright   :  (c) Peter De Wachter and Andrea Rossato 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- Screenshot  :  <http://caladan.rave.org/magnifier.png>+--+-- This is a layout modifier that will make a layout increase the size+-- of the window that has focus.+--+-----------------------------------------------------------------------------+++module XMonad.Layout.Magnifier+    ( -- * Usage+      -- $usage+      magnifier,+      magnifier',+      magnifierOff,+      magnifiercz,+      magnifiercz',+      maximizeVertical,+      MagnifyMsg (..)+    ) where++import XMonad+import XMonad.StackSet+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Magnifier+--+-- Then edit your @layoutHook@ by adding the 'magnifier' layout modifier+-- to some layout:+--+-- > myLayouts = magnifier (Tall 1 (3/100) (1/2))  ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- By default magnifier increases the focused window's size by 1.5.+-- You can also use:+--+-- > magnifiercz 1.2+--+-- to use a custom level of magnification.  You can even make the focused+-- window smaller for a pop in effect.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- Magnifier supports some commands. To use them add something like+-- this to your key bindings:+--+-- >    , ((modMask x .|. controlMask              , xK_plus ), sendMessage MagnifyMore)+-- >    , ((modMask x .|. controlMask              , xK_minus), sendMessage MagnifyLess)+-- >    , ((modMask x .|. controlMask              , xK_o    ), sendMessage ToggleOff  )+-- >    , ((modMask x .|. controlMask .|. shiftMask, xK_o    ), sendMessage ToggleOn   )+-- >    , ((modMask x .|. controlMask              , xK_m    ), sendMessage Toggle     )+--+-- Note that a few other extension modules, such as+-- "XMonad.Layout.MultiToggle" and "XMonad.Layout.ToggleLayouts", also+-- define a message named 'Toggle'.  To avoid conflicts when using+-- these modules together, you can import Magnifier qualified, like+-- this:+--+-- > import qualified XMonad.Layout.Magnifier as Mag+--+-- and then prefix @Mag@ to the front of everything from this module,+-- like @Mag.Toggle@, @Mag.magnifier@, and so on.+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | Increase the size of the window that has focus+magnifier :: l a -> ModifiedLayout Magnifier l a+magnifier = ModifiedLayout (Mag (1.5,1.5) On All)++-- | Change the size of the window that has focus by a custom zoom+magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) 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,1.5) On NoMaster)++-- | Magnifier that defaults to Off+magnifierOff :: l a -> ModifiedLayout Magnifier l a+magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All)++-- | Increase the size of the window that has focus by a custom zoom,+-- unless if it is the master window.+magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a+magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster)++-- | A magnifier that greatly magnifies just the vertical direction+maximizeVertical :: l a -> ModifiedLayout Magnifier l a+maximizeVertical = ModifiedLayout (Mag (1,1000) Off All)++data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )+instance Message MagnifyMsg++data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show)++data Toggle        = On  | Off      deriving  (Read, Show)+data MagnifyMaster = All | NoMaster deriving  (Read, Show)++instance LayoutModifier Magnifier Window where+    redoLayout  (Mag z On All     ) r (Just s) wrs = applyMagnifier z r s wrs+    redoLayout  (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs+    redoLayout  _                   _ _        wrs = return (wrs, Nothing)++    handleMess (Mag z On  t) m+                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto`   0.1 ) On  t)+                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On  t)+                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z      ) Off t)+                    | Just Toggle      <- fromMessage m = return . Just $ (Mag (z      ) Off t)+                    where addto (x,y) i = (x+i,y+i)+    handleMess (Mag z Off t) m+                    | Just ToggleOn    <- fromMessage m = return . Just $ (Mag z         On  t)+                    | Just Toggle      <- fromMessage m = return . Just $ (Mag z         On  t)+    handleMess _ _ = return Nothing++    modifierDescription (Mag _ On  All     ) = "Magnifier"+    modifierDescription (Mag _ On  NoMaster) = "Magnifier NoMaster"+    modifierDescription (Mag _ Off _       ) = "Magnifier (off)"++type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))++unlessMaster :: NewLayout a -> NewLayout a+unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)+                                              else mainmod r s wrs++applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]+               -> X ([(Window, Rectangle)], Maybe a)+applyMagnifier z r _ wrs = do focused <- withWindowSet (return . peek)+                              let mag (w,wr) ws | focused == Just w = ws ++ [(w, fit r $ magnify z wr)]+                                                | otherwise         = (w,wr) : ws+                              return (reverse $ foldr mag [] wrs, Nothing)++magnify :: (Double, Double) -> Rectangle -> Rectangle+magnify (zoomx,zoomy) (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 * zoomx+          h' = round $ fromIntegral h * zoomy++fit :: Rectangle -> Rectangle -> Rectangle+fit (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'+    where x' = max sx (x - (max 0 (x + fi w - sx - fi sw)))+          y' = max sy (y - (max 0 (y + fi h - sy - fi sh)))+          w' = min sw w+          h' = min sh h++fi :: (Num b, Integral a) => a -> b+fi = fromIntegral
+ XMonad/Layout/Master.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Master+-- Copyright   :  (c) Ismael Carnales, Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Ismael Carnales <icarnales@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modfier that adds a master window to another layout.+-----------------------------------------------------------------------------++module XMonad.Layout.Master (+    -- * Usage+    -- $usage++    mastered+) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Master+--+-- Then edit your @layoutHook@ and add the Master modifier to the layout that+-- you prefer.+--+-- > mastered (1/100) (1/2) $ Grid+--+-- This will use the left half of your screen for a master window and let+-- Grid manage the right half.+--+-- For more detailed instructions on editing the layoutHook see+-- "XMonad.Doc.Extending#Editing_the_layout_hook".+--+-- Like 'XMonad.Layout.Tall', 'withMaster' supports the+-- 'XMonad.Layout.Shrink' and XMonad.Layout.Expand' messages.++-- | Data type for LayoutModifier which converts given layout to a mastered+-- layout+data AddMaster a = AddMaster Rational Rational deriving (Show, Read)++-- | Modifier wich converts given layout to a mastered one+mastered :: (LayoutClass l a) =>+       Rational -- ^ @delta@, the ratio of the screen to resize by+    -> Rational -- ^ @frac@, what portion of the screen to use for the master window+    -> l a      -- ^ the layout to be modified+    -> ModifiedLayout AddMaster l a+mastered delta frac = ModifiedLayout $ AddMaster delta frac++instance LayoutModifier AddMaster Window where+    modifyLayout (AddMaster delta frac) = applyMaster delta frac+    modifierDescription _               = "Mastered"++    pureMess (AddMaster delta frac) m+        | Just Shrink <- fromMessage m = Just $ AddMaster delta (frac-delta)+        | Just Expand <- fromMessage m = Just $ AddMaster delta (frac+delta)++    pureMess _ _ = Nothing++-- | Internal function for adding a master window and let the modified+-- layout handle the rest of the windows+applyMaster :: (LayoutClass l Window) =>+                  Rational+               -> Rational+               -> S.Workspace WorkspaceId (l Window) Window+               -> Rectangle+               -> X ([(Window, Rectangle)], Maybe (l Window))+applyMaster _ frac wksp rect = do+    let st= S.stack wksp+    let ws = S.integrate' $ st+    if length ws > 1 then do+        let m = head ws+        let (mr, sr) = splitHorizontallyBy frac rect+        let nst = st>>= S.filter (m/=)+        wrs <- runLayout (wksp {S.stack = nst}) sr+        return ((m, mr) : fst wrs, snd wrs)++        else runLayout wksp rect
+ XMonad/Layout/Maximize.hs view
@@ -0,0 +1,84 @@+{-# 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 qualified XMonad.StackSet as S+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"+    pureModifier (Maximize (Just target)) rect (Just (S.Stack focused _ _)) wrs =+            if focused == target+                then (maxed ++ rest, Nothing)+                else (rest ++ maxed, Nothing)+        where+            (toMax, rest) = partition (\(w, _) -> w == target) wrs+            maxed = map (\(w, _) -> (w, maxRect)) toMax+            maxRect = Rectangle (rect_x rect + 25) (rect_y rect + 25)+                (rect_width rect - 50) (rect_height rect - 50)+    pureModifier _ _ _ wrs = (wrs, Nothing)++    pureMess (Maximize mw) m = case fromMessage m of+        Just (MaximizeRestore w) -> case mw of+            Just w' -> if (w == w')+                        then Just $ Maximize Nothing   -- restore window+                        else Just $ Maximize $ Just w  -- maximize different window+            Nothing -> Just $ Maximize $ Just w        -- maximize window+        _ -> Nothing++-- vim: sw=4:et
+ XMonad/Layout/Minimize.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Minimize+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.Minimize (+        minimize,+        MinimizeMsg(..)+    ) where++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Layout.LayoutModifier+import XMonad.Layout.BoringWindows as BW+import Data.List++data Minimize a = Minimize [Window] deriving ( Read, Show )+minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window+minimize = ModifiedLayout $ Minimize []++data MinimizeMsg = MinimizeWin Window+                    | RestoreMinimizedWin Window+                    | RestoreNextMinimizedWin+                    deriving (Typeable, Eq)+instance Message MinimizeMsg++instance LayoutModifier Minimize Window where+    modifierDescription (Minimize _) = "Minimize"++    modifyLayout (Minimize minimized) wksp rect = do+        let stack = W.stack wksp+            filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))+        runLayout (wksp {W.stack = filtStack}) rect++    handleMess (Minimize minimized) m = case fromMessage m of+        Just (MinimizeWin w)+          | not (w `elem` minimized) -> do+                BW.focusDown+                return $ Just $ Minimize (w:minimized)+          | otherwise               -> return Nothing+        Just (RestoreMinimizedWin w) ->+            return $ Just $ Minimize (minimized \\ [w])+        Just (RestoreNextMinimizedWin)+          | not (null minimized)    -> do+                focus (head minimized)+                return $ Just $ Minimize (tail minimized)+          | otherwise               -> return Nothing+        _ -> return Nothing
+ XMonad/Layout/Monitor.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Monitor+-- Copyright   :  (c) Roman Cheplyaka+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Layout modfier for displaying some window (monitor) above other windows+--+-----------------------------------------------------------------------------+module XMonad.Layout.Monitor (+    -- * Usage+    -- $usage++    -- * Hints and issues+    -- $hints++    Monitor(..),+    monitor,+    Property(..),+    MonitorMessage(..),+    doHideIgnore,+    manageMonitor++    -- * TODO+    -- $todo+    ) where++import XMonad+import XMonad.Layout.LayoutModifier+import XMonad.Util.WindowProperties+import XMonad.Hooks.ManageHelpers (doHideIgnore)+import XMonad.Hooks.FadeInactive (setOpacity)+import Control.Monad++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Monitor+--+-- Define 'Monitor' record. 'monitor' can be used as a template. At least 'prop'+-- and 'rect' should be set here. Also consider setting 'persistent' to True.+--+-- Minimal example:+--    +-- > myMonitor = monitor+-- >     { prop = ClassName "SomeClass"+-- >     , rect = Rectangle 0 0 40 20 -- rectangle 40x20 in upper left corner+-- >     } +--+-- More interesting example:+--         +-- > clock = monitor {+-- >      -- Cairo-clock creates 2 windows with the same classname, thus also using title+-- >      prop = ClassName "Cairo-clock" `And` Title "MacSlow's Cairo-Clock"+-- >      -- rectangle 150x150 in lower right corner, assuming 1280x800 resolution+-- >    , rect = Rectangle (1280-150) (800-150) 150 150+-- >      -- avoid flickering+-- >    , persistent = True+-- >      -- make the window transparent+-- >    , opacity = 0xAAAAAAAA+-- >      -- hide on start+-- >    , visible = False+-- >      -- assign it a name to be able to toggle it independently of others+-- >    , name = "clock"+-- >    }+--+-- Add ManageHook to de-manage monitor windows and apply opacity settings.+-- +-- > manageHook = myManageHook <+> manageMonitor clock+-- +-- Apply layout modifier.+-- +-- > myLayouts = ModifiedLayout clock $ tall ||| Full ||| ...+-- +-- After that, if there exists a window with specified properties, it will be+-- displayed on top of all /tiled/ (not floated) windows on specified+-- position.+--+-- It's also useful to add some keybinding to toggle monitor visibility:+-- +-- > , ((mod1Mask, xK_u     ), broadcastMessage ToggleMonitor >> refresh)+--+-- Screenshot: <http://www.haskell.org/haskellwiki/Image:Xmonad-clock.png>++data Monitor a = Monitor+    { prop :: Property   -- ^ property which uniquely identifies monitor window+    , rect :: Rectangle  -- ^ specifies where to put monitor+    , visible :: Bool    -- ^ is it visible by default?+    , name :: String     -- ^ name of monitor (useful when we have many of them)+    , persistent :: Bool -- ^ is it shown on all layouts?+    , opacity :: Integer -- ^ opacity level+    } deriving (Read, Show)++-- | Template for 'Monitor' record. At least 'prop' and 'rect' should be+-- redefined. Default settings: 'visible' is 'True', 'persistent' is 'False'.+monitor :: Monitor a+monitor = Monitor+    { prop = Const False+    , rect = Rectangle 0 0 0 0+    , visible = True+    , name = ""+    , persistent = False+    , opacity = 0xFFFFFFFF+    }++-- | Messages without names affect all monitors. Messages with names affect only+-- monitors whose names match.+data MonitorMessage = ToggleMonitor | ShowMonitor | HideMonitor+                    | ToggleMonitorNamed String+                    | ShowMonitorNamed String+                    | HideMonitorNamed String+    deriving (Read,Show,Eq,Typeable)+instance Message MonitorMessage++withMonitor :: Property -> a -> (Window -> X a) -> X a+withMonitor p a fn = do+    monitorWindows <- allWithProperty p+    case monitorWindows of+        [] -> return a+        w:_ -> fn w++instance LayoutModifier Monitor Window where+    redoLayout mon _ _ rects = withMonitor (prop mon) (rects, Nothing) $ \w ->+        if visible mon+            then do tileWindow w (rect mon)+                    reveal w+                    return ((w,rect mon):rects, Nothing)+            else do hide w+                    return (rects, Nothing)+    handleMess mon mess+        | Just ToggleMonitor <- fromMessage mess = return $ Just $ mon { visible = not $ visible mon }+        | Just (ToggleMonitorNamed n) <- fromMessage mess = return $+            if name mon == n then Just $ mon { visible = not $ visible mon } else Nothing+        | Just ShowMonitor <- fromMessage mess = return $ Just $ mon { visible = True }+        | Just (ShowMonitorNamed n) <- fromMessage mess = return $+            if name mon == n then Just $ mon { visible = True } else Nothing+        | Just HideMonitor <- fromMessage mess = return $ Just $ mon { visible = False }+        | Just (HideMonitorNamed n) <- fromMessage mess = return $+            if name mon == n then Just $ mon { visible = False } else Nothing+        | Just Hide <- fromMessage mess = do unless (persistent mon) $ withMonitor (prop mon) () hide; return Nothing+        | otherwise = return Nothing+        +-- | ManageHook which demanages monitor window and applies opacity settings.+manageMonitor :: Monitor a -> ManageHook+manageMonitor mon = propertyToQuery (prop mon) --> do+    w <- ask+    liftX $ setOpacity w $ opacity mon+    if persistent mon then doIgnore else doHideIgnore++-- $hints+-- - This module assumes that there is only one window satisfying property exists.+--+-- - If your monitor is available on /all/ layouts, set+-- 'persistent' to 'True' to avoid unnecessary+-- flickering. You can still toggle monitor with a keybinding.+--+-- - You can use several monitors with nested modifiers. Give them names+---  to be able to toggle them independently.+--+-- - You can display monitor only on specific workspaces with+-- "XMonad.Layout.PerWorkspace".++-- $todo+-- - make Monitor remember the window it manages+--+-- - specify position relative to the screen
+ XMonad/Layout/Mosaic.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Mosaic+-- Copyright   :  (c) 2009 Adam Vogt, 2007 James Webb+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  vogt.adam<at>gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Based on MosaicAlt, but aspect ratio messages always change the aspect+-- ratios, and rearranging the window stack changes the window sizes.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Mosaic (+    -- * Usage+    -- $usage+    Mosaic(Mosaic)+    ,Aspect(..)+    ,shallower+    ,steeper+    ,growMaster+    ,shrinkMaster+    ,changeMaster+    )+    where++import Prelude hiding (sum)++import XMonad(Typeable,+              LayoutClass(doLayout , pureMessage, description), Message,+              fromMessage, splitHorizontallyBy, splitVerticallyBy, Rectangle)+import XMonad.StackSet(integrate)+import Data.Foldable(Foldable(foldMap), sum)+import Data.Monoid(Monoid(mappend, mempty))++-- $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 (take 5 $ iterate (*0.7) 1) ||| Mosaic [3,1,1,1,1,1] ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- Unfortunately, infinite lists break serialization, so don't use them.+--+-- To change the choice in aspect ratio and the relative sizes of windows, add+-- to your keybindings:+--+--  > , ((modMask, xK_a), sendMessage Taller)+--  > , ((modMask, xK_z), sendMessage Wider)+--  > , ((modMask, xK_h), sendMessage Shrink >> sendMessage (SlopeMod shallower))+--  > , ((modMask, xK_l), sendMessage Expand >> sendMessage (SlopeMod steeper))+--+--  > , ((modMask, xK_r), sendMessage Reset)+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Aspect+    = Taller+    | Wider+    | Reset+    | SlopeMod ([Rational] -> [Rational])+    deriving (Typeable)++instance Message Aspect++data Mosaic a+    {- | The relative magnitudes (the sign is ignored) of the rational numbers+     - provided determine the relative areas that the windows receive. The+     - first number represents the size of the master window, the second is for+     - the next window in the stack, and so on. Windows without a list element+     - are hidden.+    -}+    = Mosaic [Rational]+    -- override the aspect? current index, maximum index+    | MosaicSt Bool Rational Int [Rational]+    deriving (Read, Show)++instance LayoutClass Mosaic a where+    description = const "Mosaic"++    pureMessage (Mosaic _ss) _ms = Nothing+    pureMessage (MosaicSt _ ix mix ss) ms = fromMessage ms >>= ixMod+        where ixMod Taller | rix >= mix = Nothing+                           | otherwise = Just $ MosaicSt False (succ ix) mix ss+              ixMod Wider  | rix <= 0   = Nothing+                           | otherwise = Just $ MosaicSt False (pred ix) mix ss+              ixMod Reset              = Just $ Mosaic ss+              ixMod (SlopeMod f)       = Just $ MosaicSt False ix mix (f ss)+              rix = round ix++    doLayout (Mosaic ss) r st = return (zip (integrate st) rect, newLayout)+        where rects = splits (length $ integrate st) r ss+              lrects = length rects+              rect = rects !! (lrects `div` 2)+              newLayout = Just $ MosaicSt True (fromIntegral lrects / 2) (pred lrects) ss++    doLayout (MosaicSt override ix mix ss) r st+                                = return (zip (integrate st) rect, newLayout)+        where rects = splits (length $ integrate st) r ss+              lrects = length rects+              nix = if mix == 0 || override then fromIntegral $ lrects `div` 2+                        else max 0 $ min (fromIntegral $ pred lrects)+                            $ fromIntegral (pred lrects) * ix / fromIntegral mix+              rect = rects !! round nix+              newLayout = Just $ MosaicSt override nix (pred lrects) ss++-- | These sample functions are meant to be applied to the list of window sizes+-- through the 'SlopeMod' message.+--+-- Steeper and shallower scale the ratios of successive windows.+--+-- growMaster and shrinkMaster just increase and decrease the size of the first+-- element, and thus they change the layout very similarily to the standard+-- 'Expand' or 'Shrink' for the 'Tall' layout.+--+-- It may be possible to resize the specific focused window; however the same+-- result could probably be achieved by promoting it, or moving it to a higher+-- place in the list of windows; when you have a decreasing list of window+-- sizes, the change in position will also result in a change in size.++steeper :: [Rational] -> [Rational]+steeper [] = []+steeper xs = map (subtract (minimum xs*0.8)) xs++shallower :: [Rational] -> [Rational]+shallower [] = []+shallower xs = map (+(minimum xs*2)) xs++growMaster :: [Rational] -> [Rational]+growMaster = changeMaster 2++shrinkMaster :: [Rational] -> [Rational]+shrinkMaster = changeMaster 0.5++-- | Multiply the area of the current master by a specified ratio+changeMaster :: Rational -> [Rational] -> [Rational]+changeMaster _ [] = []+changeMaster f (x:xs) = f*x:xs++splits :: Int -> Rectangle -> [Rational] -> [[Rectangle]]+splits num rect = splitsL rect . makeTree . normalize+                            . map abs . reverse . take num++-- recursively enumerate splits+splitsL :: Rectangle -> Tree Rational -> [[Rectangle]]+splitsL _rect Empty = []+splitsL rect (Leaf _) = [[rect]]+splitsL rect (Branch l r) = do+    let mkSplit f = f (sum l / (sum l + sum r)) rect+    (rl,rr) <- map mkSplit [splitVerticallyBy,splitHorizontallyBy]+    splitsL rl l `interleave` splitsL rr r++-- like zipWith (++), but when one list is shorter, its elements are duplicated+-- so that they match+interleave :: [[a]] -> [[a]] -> [[a]]+interleave xs ys | lx > ly = zc xs (extend lx ys)+                 | otherwise = zc (extend ly xs) ys+    where lx = length xs+          ly = length ys+          zc = zipWith (++)++extend :: Int -> [a] -> [a]+extend n pat = do+    (p,e) <- zip pat $ replicate m True ++ repeat False+    [p | e] ++ replicate d p+    where (d,m) = n `divMod` length pat++normalize :: Fractional a => [a] -> [a]+normalize x = let s = sum x+    in map (/s) x++data Tree a = Branch (Tree a) (Tree a) | Leaf a | Empty+    deriving (Show)++instance Foldable Tree where+   foldMap _f Empty = mempty+   foldMap f (Leaf x) = f x+   foldMap f (Branch l r) = foldMap f l `mappend` foldMap f r++instance Monoid (Tree a) where+    mempty = Empty+    mappend Empty x = x+    mappend x Empty = x+    mappend x y = Branch x y++makeTree :: [Rational] -> Tree Rational+makeTree [] = Empty+makeTree [x] = Leaf x+makeTree xs = Branch (makeTree a) (makeTree b)+    where ((a,b),_) = foldr w (([],[]),(0,0)) xs+          w n ((ls,rs),(l,r)) = if l > r then ((ls,n:rs),(l,n+r))+                                        else ((n:ls,rs),(n+l,r))
+ 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/MouseResizableTile.hs view
@@ -0,0 +1,246 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MouseResizableTile+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.MouseResizableTile (+                                    mouseResizableTile,+                                    mouseResizableTileMirrored,+                                    MRTMessage (ShrinkSlave, ExpandSlave)+                                   ) where++import XMonad hiding (tile, splitVertically, splitHorizontallyBy)+import qualified XMonad.StackSet as W+import XMonad.Util.XUtils++data MRTMessage = SetMasterFraction Rational+                    | SetLeftSlaveFraction Int Rational+                    | SetRightSlaveFraction Int Rational+                    | ShrinkSlave+                    | ExpandSlave+                    deriving Typeable+instance Message MRTMessage++data DraggerInfo = MasterDragger Position Rational+                    | LeftSlaveDragger Position Rational Int+                    | RightSlaveDragger Position Rational Int+                    deriving (Show, Read)+type DraggerWithRect = (Rectangle, Glyph, DraggerInfo)+type DraggerWithWin = (Window, DraggerInfo)++data MouseResizableTile a = MRT { nmaster :: Int,+                                    masterFrac :: Rational,+                                    leftFracs :: [Rational],+                                    rightFracs :: [Rational],+                                    draggers :: [DraggerWithWin],+                                    focusPos :: Int,+                                    numWindows :: Int,+                                    isMirrored :: Bool+                                } deriving (Show, Read)++mrtFraction :: Rational+mrtFraction = 0.5+mrtDelta :: Rational+mrtDelta = 0.03+mrtDraggerOffset :: Position+mrtDraggerOffset = 3+mrtDraggerSize :: Dimension+mrtDraggerSize = 6+mrtHDoubleArrow :: Glyph+mrtHDoubleArrow = 108+mrtVDoubleArrow :: Glyph+mrtVDoubleArrow = 116++mouseResizableTile :: MouseResizableTile a+mouseResizableTile = MRT 1 mrtFraction [] [] [] 0 0 False++mouseResizableTileMirrored :: MouseResizableTile a+mouseResizableTileMirrored= MRT 1 mrtFraction [] [] [] 0 0 True++instance LayoutClass MouseResizableTile a where+    doLayout state sr (W.Stack w l r) =+        let wins = reverse l ++ w : r+            num = length wins+            sr' = mirrorAdjust sr (mirrorRect sr)+            (rects, preparedDraggers) = tile (nmaster state) (masterFrac state)+                                            ((leftFracs state) ++ repeat mrtFraction)+                                            ((rightFracs state) ++ repeat mrtFraction) sr' num+            rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects+        in do+            mapM_ deleteDragger $ draggers state+            newDraggers <- mapM (createDragger sr . adjustForMirror (isMirrored state)) preparedDraggers+            return (zip wins rects', Just $ state { draggers = newDraggers,+                                                    focusPos = length l,+                                                    numWindows = length wins })+        where+            mirrorAdjust a b = if (isMirrored state)+                                then b+                                else a++    handleMessage state m+        | Just (IncMasterN d) <- fromMessage m =+            return $ Just $ state { nmaster = max 0 (nmaster state + d) }+        | Just (Shrink) <- fromMessage m =+            return $ Just $ state { masterFrac = max 0 (masterFrac state - mrtDelta) }+        | Just (Expand) <- fromMessage m =+            return $ Just $ state { masterFrac = min 1 (masterFrac state + mrtDelta) }+        | Just ShrinkSlave <- fromMessage m =+            return $ Just $ modifySlave state (-mrtDelta)+        | Just ExpandSlave <- fromMessage m =+            return $ Just $ modifySlave state mrtDelta+        | Just (SetMasterFraction f) <- fromMessage m =+            return $ Just $ state { masterFrac = max 0 (min 1 f) }+        | Just (SetLeftSlaveFraction pos f) <- fromMessage m =+            return $ Just $ state { leftFracs = replaceAtPos (leftFracs state) pos (max 0 (min 1 f)) }+        | Just (SetRightSlaveFraction pos f) <- fromMessage m =+            return $ Just $ state { rightFracs = replaceAtPos (rightFracs state) pos (max 0 (min 1 f)) }++        | Just e <- fromMessage m :: Maybe Event = handleResize (draggers state) (isMirrored state) e >> return Nothing+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] })+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ state { draggers = [] })+        where releaseResources = mapM_ deleteDragger $ draggers state+    handleMessage _ _ = return Nothing++    description _ = "MouseResizableTile"++adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect+adjustForMirror False dragger = dragger+adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =+        (mirrorRect draggerRect, draggerCursor', draggerInfo)+    where+        draggerCursor' = if (draggerCursor == mrtHDoubleArrow)+                            then mrtVDoubleArrow+                            else mrtHDoubleArrow++modifySlave :: MouseResizableTile a -> Rational-> MouseResizableTile a+modifySlave state delta =+    let pos = focusPos state+        num = numWindows state+        nmaster' = nmaster state+        leftFracs' = leftFracs state+        rightFracs' = rightFracs state+        draggersLeft = nmaster' - 1+        draggersRight = (num - nmaster') - 1+    in if pos < nmaster'+        then if draggersLeft > 0+                then let draggerPos = min (draggersLeft - 1) pos+                         oldFraction = (leftFracs' ++ repeat mrtFraction) !! draggerPos+                     in state { leftFracs = replaceAtPos leftFracs' draggerPos+                                            (max 0 (min 1 (oldFraction + delta))) }+                else state+        else if draggersRight > 0+                then let draggerPos = min (draggersRight - 1) (pos - nmaster')+                         oldFraction = (rightFracs' ++ repeat mrtFraction) !! draggerPos+                     in state { rightFracs = replaceAtPos rightFracs' draggerPos+                                            (max 0 (min 1 (oldFraction + delta))) }+                else state++replaceAtPos :: (Num t) => [Rational] -> t -> Rational -> [Rational]+replaceAtPos [] 0 x' = [x']+replaceAtPos [] pos x' = mrtFraction : replaceAtPos [] (pos - 1) x'+replaceAtPos (_:xs) 0 x' = x' : xs+replaceAtPos (x:xs) pos x' = x : replaceAtPos xs (pos -1 ) x'++sanitizeRectangle :: Rectangle -> Rectangle -> Rectangle+sanitizeRectangle (Rectangle sx sy swh sht) (Rectangle x y wh ht) =+    (Rectangle (within 0 (sx + fromIntegral swh) x) (within 0 (sy + fromIntegral sht) y)+                (within 1 swh wh) (within 1 sht ht))++within :: (Ord a) => a -> a -> a -> a+within low high a = max low $ min high a++tile :: Int -> Rational -> [Rational] -> [Rational] -> Rectangle -> Int -> ([Rectangle], [DraggerWithRect])+tile nmaster' masterFrac' leftFracs' rightFracs' sr num+    | num <= nmaster'       = splitVertically (take (num - 1) leftFracs') sr True 0+    | nmaster' == 0         = splitVertically (take (num - 1) rightFracs') sr False 0+    | otherwise             = (leftRects ++ rightRects, [masterDragger] ++ leftDraggers ++ rightDraggers)+    where ((sr1, sr2), masterDragger) = splitHorizontallyBy masterFrac' sr+          (leftRects, leftDraggers) = splitVertically (take (nmaster' - 1) leftFracs') sr1 True 0+          (rightRects, rightDraggers) = splitVertically (take (num - nmaster' - 1) rightFracs') sr2 False 0++splitVertically :: RealFrac r => [r] -> Rectangle -> Bool -> Int -> ([Rectangle], [DraggerWithRect])+splitVertically [] r _ _ = ([r], [])+splitVertically (f:fx) (Rectangle sx sy sw sh) isLeft num =+    let nextRect = Rectangle sx sy sw (smallh - (div mrtDraggerSize 2))+        (otherRects, otherDragger) = splitVertically fx+                                        (Rectangle sx (sy + fromIntegral smallh + mrtDraggerOffset)+                                                    sw (sh - smallh - (div mrtDraggerSize 2)))+                                        isLeft (num + 1)+        draggerRect = Rectangle sx (sy + fromIntegral smallh - mrtDraggerOffset) sw mrtDraggerSize+        draggerInfo = if isLeft+                        then LeftSlaveDragger sy (fromIntegral sh) num+                        else RightSlaveDragger sy (fromIntegral sh) num+        nextDragger = (draggerRect, mrtVDoubleArrow, draggerInfo)+    in (nextRect : otherRects, nextDragger : otherDragger)+  where smallh = floor $ fromIntegral sh * f++splitHorizontallyBy :: RealFrac r => r -> Rectangle -> ((Rectangle, Rectangle), DraggerWithRect)+splitHorizontallyBy f (Rectangle sx sy sw sh) = ((leftHalf, rightHalf), (draggerRect, mrtHDoubleArrow, draggerInfo))+  where leftw = floor $ fromIntegral sw * f+        leftHalf = Rectangle sx sy (leftw - (div mrtDraggerSize 2)) sh+        rightHalf = Rectangle (sx + fromIntegral leftw + mrtDraggerOffset) sy+                                (sw - fromIntegral leftw - (div mrtDraggerSize 2)) sh+        draggerRect = Rectangle (sx + fromIntegral leftw - mrtDraggerOffset) sy mrtDraggerSize sh+        draggerInfo = MasterDragger sx (fromIntegral sw)++createDragger :: Rectangle -> DraggerWithRect -> X DraggerWithWin+createDragger sr (draggerRect, draggerCursor, draggerInfo) = do+        draggerWin <- createInputWindow draggerCursor $ sanitizeRectangle sr draggerRect+        return (draggerWin, draggerInfo)++deleteDragger :: DraggerWithWin -> X ()+deleteDragger (draggerWin, _) = deleteWindow draggerWin+++handleResize :: [DraggerWithWin] -> Bool -> Event -> X ()+handleResize draggers' isM ButtonEvent { ev_window = ew, ev_event_type = et }+    | et == buttonPress = do+        case (lookup ew draggers') of+            Just (MasterDragger lowerBound range) -> do+                mouseDrag (\x y -> do+                             let axis = chooseAxis isM x y+                                 fraction = fromIntegral (axis - lowerBound) / range+                             sendMessage (SetMasterFraction fraction)) (return ())+            Just (LeftSlaveDragger lowerBound range num) -> do+                mouseDrag (\x y -> do+                             let axis = chooseAxis isM y x+                                 fraction = fromIntegral (axis - lowerBound) / range+                             sendMessage (SetLeftSlaveFraction num fraction)) (return ())+            Just (RightSlaveDragger lowerBound range num) -> do+                mouseDrag (\x y -> do+                             let axis = chooseAxis isM y x+                                 fraction = fromIntegral (axis - lowerBound) / range+                             sendMessage (SetRightSlaveFraction num fraction)) (return ())+            Nothing -> return ()+    where+        chooseAxis isM' axis1 axis2 = if isM' then axis2 else axis1+handleResize _ _ _ = return ()++createInputWindow :: Glyph -> Rectangle -> X Window+createInputWindow cursorGlyph r = withDisplay $ \d -> do+    win <- mkInputWindow d r+    io $ selectInput d win (exposureMask .|. buttonPressMask)+    cursor <- io $ createFontCursor d cursorGlyph+    io $ defineCursor d win cursor+    io $ freeCursor d cursor+    showWindow win+    return win++mkInputWindow :: Display -> Rectangle -> X Window+mkInputWindow d (Rectangle x y w h) = do+  rw <- asks theRoot+  let screen   = defaultScreenOfDisplay d+      visual   = defaultVisualOfScreen screen+      attrmask = cWOverrideRedirect+  io $ allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes True+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes
+ XMonad/Layout/MultiToggle.hs view
@@ -0,0 +1,240 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MultiToggle+-- Copyright   :  (c) Lukas Mai+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <l.mai@web.de>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Dynamically apply and unapply transformers to your window layout. This can+-- be used to rotate your window layout by 90 degrees, or to make the+-- currently focused window occupy the whole screen (\"zoom in\") then undo+-- the transformation (\"zoom out\").++module XMonad.Layout.MultiToggle (+    -- * Usage+    -- $usage+    Transformer(..),+    Toggle(..),+    (??),+    EOT(..),+    single,+    mkToggle,+    mkToggle1+) where++import XMonad++import XMonad.StackSet (Workspace(..))++import Control.Arrow+import Data.Typeable+import Data.Maybe++-- $usage+-- The basic idea is to have a base layout and a set of layout transformers,+-- of which at most one is active at any time. Enabling another transformer+-- first disables any currently active transformer; i.e. it works like a+-- group of radio buttons.+--+-- A side effect of this meta-layout is that layout transformers no longer+-- receive any messages; any message not handled by MultiToggle itself will+-- undo the current layout transformer, pass the message on to the base+-- layout, then reapply the transformer.+--+-- To use this module, you need some data types which represent+-- transformers; for some commonly used transformers (including+-- MIRROR, NOBORDERS, and FULL used in the examples below) you can+-- simply import "XMonad.Layout.MultiToggle.Instances".+--+-- Somewhere else in your file you probably have a definition of @layout@;+-- the default looks like this:+--+-- > layout = tiled ||| Mirror tiled ||| Full+--+-- After changing this to+--+-- > layout = mkToggle (single MIRROR) (tiled ||| Full)+--+-- you can now dynamically apply the 'XMonad.Layout.Mirror' transformation:+--+-- > ...+-- >   , ((modMask,               xK_x     ), sendMessage $ Toggle MIRROR)+-- > ...+--+-- (That should be part of your key bindings.) When you press @mod-x@, the+-- active layout is mirrored. Another @mod-x@ and it's back to normal.+--+-- It's also possible to stack @MultiToggle@s.  For example:+--+-- @+-- layout = id+--     . 'XMonad.Layout.NoBorders.smartBorders'+--     . mkToggle (NOBORDERS ?? FULL ?? EOT)+--     . mkToggle (single MIRROR)+--     $ tiled ||| 'XMonad.Layout.Grid.Grid' ||| 'XMonad.Layout.Circle.Circle'+-- @+--+-- By binding a key to @(sendMessage $ Toggle FULL)@ you can temporarily+-- maximize windows, in addition to being able to rotate layouts and remove+-- window borders.+--+-- You can also define your own transformers by creating a data type+-- which is an instance of the 'Transformer' class.  For example, here+-- is the definition of @MIRROR@:+--+-- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable)+-- > instance Transformer MIRROR Window where+-- >     transform _ x k = k (Mirror x)+--+-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the+-- beginning of your file (ghc 6.8 only; with ghc 6.6 you can use+-- @{-\# OPTIONS_GHC -fglasgow-exts \#-}@ instead) to be able to+-- derive "Data.Typeable".+--++-- | 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++-- | Construct a @MultiToggle@ layout from a single transformer and a base+-- layout.+mkToggle1 :: (LayoutClass l a) => t -> l a -> MultiToggle (HCons t EOT) l a+mkToggle1 t = mkToggle (single t)++-- | Marks the end of a transformer list.+data EOT = EOT deriving (Read, Show)+data HCons a b = HCons a b deriving (Read, Show)++infixr 0 ??+-- | Prepend an element to a heterogeneous list. Used to build transformer+-- tables for 'mkToggle'.+(??) :: (HList b w) => a -> b -> HCons a b+(??) = HCons++-- | Construct a singleton transformer table.+single :: a -> HCons a EOT+single = (?? EOT)++class HList c a where+    find :: (Transformer t a) => c -> t -> Maybe Int+    resolve :: c -> Int -> b -> (forall t. (Transformer t a) => t -> b) -> b++instance HList EOT w where+    find EOT _ = Nothing+    resolve EOT _ d _ = d++instance (Transformer a w, HList b w) => HList (HCons a b) w where+    find (HCons x xs) t+        | t `geq` x = Just 0+        | otherwise = fmap succ (find xs t)+    resolve (HCons x xs) n d k =+        case n `compare` 0 of+            LT -> d+            EQ -> k x+            GT -> resolve xs (pred n) d k++geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool+geq a b = Just a == cast b++acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c+acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x }))++instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where+    description mt = currLayout mt `unEL` \l -> description l++    runLayout (Workspace i mt s) r+        | isNothing (currIndex mt) =+            acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r+        | otherwise = currLayout mt `unEL` \l ->+            acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r++    handleMessage mt m+        | Just (Toggle t) <- fromMessage m+        , i@(Just _) <- find (transformers mt) t+            = currLayout mt `unEL` \l ->+            if i == currIndex mt+                then do+                    handleMessage l (SomeMessage ReleaseResources)+                    return . Just $+                        mt{+                            currLayout = EL $ baseLayout mt,+                            currIndex = Nothing,+                            currTrans = id+                        }+                else do+                    handleMessage l (SomeMessage ReleaseResources)+                    let f = transform' t+                    return . Just $+                        mt{+                            currLayout = f . EL $ baseLayout mt,+                            currIndex = i,+                            currTrans = f+                        }+        | fromMessage m == Just ReleaseResources ||+          fromMessage m == Just Hide+            = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m)+        | otherwise = do+            ml <- handleMessage (baseLayout mt) m+            case ml of+                Nothing -> return Nothing+                Just b' -> currLayout mt `unEL` \l -> do+                    handleMessage l (SomeMessage ReleaseResources)+                    return . Just $+                        mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' }
+ XMonad/Layout/MultiToggle/Instances.hs view
@@ -0,0 +1,40 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+-- above is for compatibility with GHC 6.6.+{- LANGUAGE TypeSynonymInstances, DeriveDataTypeable -}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.MultiToggle.Instances+-- Copyright   :  (c) 2008  Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Some convenient common instances of the+-- 'XMonad.Layout.MultiToggle.Transformer' class, for use with+-- "XMonad.Layout.MultiToggle".++module XMonad.Layout.MultiToggle.Instances (+  StdTransformers(..)+) where++import XMonad.Layout.MultiToggle++import XMonad+import XMonad.Layout.NoBorders++data StdTransformers = FULL          -- ^ switch to Full layout+                     | NBFULL        -- ^ switch to Full with no borders+                     | MIRROR        -- ^ Mirror the current layout.+                     | NOBORDERS     -- ^ Remove borders.+                     | SMARTBORDERS  -- ^ Apply smart borders.+  deriving (Read, Show, Eq, Typeable)++instance Transformer StdTransformers Window where+    transform FULL         _ k = k Full+    transform NBFULL       _ k = k (noBorders Full)+    transform MIRROR       x k = k (Mirror x)+    transform NOBORDERS    x k = k (noBorders x)+    transform SMARTBORDERS x k = k (smartBorders x)
+ XMonad/Layout/Named.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Named+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for assigning a name to a given layout.+--+-----------------------------------------------------------------------------++module XMonad.Layout.Named+    ( -- * Usage+      -- $usage+      named,+      nameTail+    ) where++import XMonad+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Named+--+-- Then edit your @layoutHook@ by adding the Named layout modifier+-- to some layout:+--+-- > myLayouts = named "real big" Full ||| (nameTail $ 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"++-- | Rename a layout.+named :: String -> l a -> ModifiedLayout Named l a+named s = ModifiedLayout (Named s)++data Named a = Named String deriving ( Read, Show )++instance LayoutModifier Named a where+    modifyDescription (Named n) _ = n+++-- | Remove the first word of the name.+nameTail :: l a -> ModifiedLayout NameTail l a+nameTail = ModifiedLayout NameTail++data NameTail a = NameTail deriving (Read,Show)++instance LayoutModifier NameTail a where+  modifyDescription NameTail i = dropWhile (==' ') $ dropWhile (/=' ') $ description i
+ XMonad/Layout/NoBorders.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+{-# LANGUAGE PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.NoBorders+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- 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,+                                lessBorders,+                                SetsAmbiguous(..),+                                Ambiguity(..),+                                With(..)+                               ) where++import XMonad+import XMonad.Layout.LayoutModifier+import qualified XMonad.StackSet as W+import Control.Monad+import Data.List+import qualified Data.Map as M+import Data.Function (on)++-- $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++-- | Removes all window borders from the specified layout.+noBorders :: LayoutClass l Window => l Window -> ModifiedLayout WithBorder l Window+noBorders = withBorder 0++-- | Forces a layout to use the specified border width. 'noBorders' is+-- equivalent to @'withBorder' 0@.+withBorder :: LayoutClass l a => Dimension -> l a -> ModifiedLayout WithBorder l a+withBorder b = ModifiedLayout $ WithBorder b []++setBorders :: [Window] -> Dimension -> X ()+setBorders ws bw = withDisplay $ \d -> mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws++singleton :: [a] -> Bool+singleton = null . drop 1++type SmartBorder = ConfigurableBorder Ambiguity++-- | Removes the borders from a window under one of the following conditions:+--+--  * There is only one screen and only one window. In this case it's obvious+--  that it has the focus, so no border is needed.+--+--  * A floating window covers the entire screen (e.g. mplayer).+--+smartBorders :: LayoutClass l a => l a -> ModifiedLayout SmartBorder l a+smartBorders = lessBorders Never++-- | Apply a datatype that has a SetsAmbiguous instance to provide a list of+-- windows that should not have borders.+--+-- This gives flexibility over when borders should be drawn, in particular with+-- xinerama setups: 'Ambiguity' has a number of useful 'SetsAmbiguous'+-- instances+lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>+        p -> l a -> ModifiedLayout (ConfigurableBorder p) l a+lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])++data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show)++instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where+    unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s++    redoLayout (ConfigurableBorder p s) _ mst wrs = do+        ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))+        asks (borderWidth . config) >>= setBorders (s \\ ws)+        setBorders ws 0+        return (wrs, Just $ ConfigurableBorder p ws)++-- | SetsAmbiguous allows custom actions to generate lists of windows that+-- should not have borders drawn through 'ConfigurableBorder'+--+-- To add your own (though perhaps those options would better belong as an+-- aditional constructor to 'Ambiguity'), you can add the function as such:+--+-- > data MyAmbiguity = MyAmbiguity deriving (Read, Show)+--+-- > instance SetsAmbiguous MyAmbiguity where+-- >  hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat+-- >     where otherHiddens p = hiddens p wset mst wrs+--+-- The above example is redundant, because you can have the same result with:+--+-- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )+--+-- To get the same result as smartBorders:+--+-- > layoutHook = lessBorders (Combine Never) (Tall 1 0.5 0.03 ||| ...)+--+-- This indirect method is required to keep the Read and Show for+-- ConfigurableBorder so that xmonad can serialize state.+class SetsAmbiguous p where+    hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]++instance SetsAmbiguous Ambiguity where+    hiddens amb wset mst wrs+      | Combine Union a b <- amb = on union next a b+      | Combine Difference a b <- amb = on (\\) next a b+      | Combine Intersection a b <- amb = on intersect next a b+      | otherwise = tiled ms ++ floating+      where next p = hiddens p wset mst wrs+            nonzerorect (Rectangle _ _ 0 0) = False+            nonzerorect _ = True++            screens =+              [ scr | scr <- W.screens wset,+                      case amb of+                            Never -> True+                            _ -> not $ null $ integrate scr,+                      nonzerorect . screenRect $ W.screenDetail scr]+            floating = [ w |+                        (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,+                        px <= 0, py <= 0,+                        wx + px >= 1, wy + py >= 1]+            ms = filter (`elem` W.integrate' mst) $ map fst wrs+            tiled [w]+              | Screen <- amb = [w]+              | OnlyFloat <- amb = []+              | OtherIndicated <- amb+              , let nonF = map integrate $ W.current wset : W.visible wset+              , length (concat nonF) > length wrs+              , singleton $ filter (1==) $ map length nonF = [w]+              | singleton screens = [w]+            tiled _ = []+            integrate y = W.integrate' . W.stack $ W.workspace y++-- | In order of increasing ambiguity (less borders more frequently), where+-- subsequent constructors add additional cases where borders are not drawn+-- than their predecessors. These behaviors make most sense with with multiple+-- screens: for single screens, Never or 'smartBorders' makes more sense.+data Ambiguity = Combine With Ambiguity Ambiguity+                             -- ^ This constructor is used to combine the+                             -- borderless windows provided by the+                             -- SetsAmbiguous instances from two other+                             -- 'Ambiguity' data types.+               | OnlyFloat   -- ^ Only remove borders on floating windows that+                             -- cover the whole screen+               | Never       -- ^ Never remove borders when ambiguous:+                             -- this is the same as smartBorders+               | EmptyScreen -- ^ Focus in an empty screens does not count as+                             -- ambiguous.+               | OtherIndicated+                             -- ^ No borders on full when all other screens+                             -- have borders.+               | Screen      -- ^ Borders are never drawn on singleton screens.+                             -- With this one you really need another way such+                             -- as a statusbar to detect focus.+    deriving (Read, Show)++-- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two+-- lists should be combined.+data With = Union        -- ^ Combine with Data.List.union+          | Difference   -- ^ Combine with Data.List.\\+          | Intersection -- ^ Combine with Data.List.intersect+        deriving (Read, Show)
+ XMonad/Layout/NoFrillsDecoration.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.NoFrillsDecoration+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.NoFrillsDecoration+    ( noFrillsDeco+    ) where++import XMonad.Layout.Decoration++-- | Add very simple decorations to windows of a layout.+noFrillsDeco :: (Eq a, Shrinker s) => s -> Theme+             -> l a -> ModifiedLayout (Decoration NoFrillsDecoration s) l a+noFrillsDeco s c = decoration s c $ NFD True++data NoFrillsDecoration a = NFD Bool deriving (Show, Read)++instance Eq a => DecorationStyle NoFrillsDecoration a where+    describeDeco _ = "NoFrillsDeco"
+ XMonad/Layout/OneBig.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.OneBig+-- Copyright   :  (c) 2009 Ilya Portnov+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Provides layout named OneBig. It places one (master) window at top left corner of screen, and other (slave) windows at top+--+-----------------------------------------------------------------------------++module XMonad.Layout.OneBig (+                             -- * Usage+                             -- $usage+                             OneBig (..)+                            ) where+import XMonad+import qualified XMonad.StackSet as W++-- $usage+-- This module defines layout named OneBig. It places one (master)+-- window at top left, and other (slave) windows at right and at+-- bottom of master. It tries to give equal space for each slave+-- window.+--+-- You can use this module by adding folowing in your @xmonad.hs@:+--+-- > import XMonad.Layout.OneBig+--+-- Then add layouts to your layoutHook:+--+-- > myLayoutHook = OneBig (3/4) (3/4) ||| ...+--+-- In this example, master window will occupy 3/4 of screen width and+-- 3/4 of screen height.++-- | Data type for layout+data OneBig a = OneBig Float Float deriving (Read,Show)++instance LayoutClass OneBig a where+  pureLayout = oneBigLayout+  pureMessage = oneBigMessage++-- | Processes Shrink/Expand messages+oneBigMessage :: OneBig a -> SomeMessage -> Maybe (OneBig a)+oneBigMessage (OneBig cx cy) m = fmap resize (fromMessage m)+    where resize Shrink = OneBig (cx-delta) (cy-delta)+          resize Expand = OneBig (cx+delta) (cy+delta)+          delta = 3/100++-- | Main layout function+oneBigLayout :: OneBig a -> Rectangle -> W.Stack a -> [(a, Rectangle)]+oneBigLayout (OneBig cx cy) rect stack = [(master,masterRect)] +                                      ++ (divideBottom bottomRect bottomWs)+                                      ++ (divideRight rightRect rightWs)+      where ws = W.integrate stack+            n = length ws+            ht (Rectangle _ _ _ hh) = hh+            wd (Rectangle _ _ ww _) = ww+            h' = round (fromIntegral (ht rect)*cy)+            w = wd rect+            m = calcBottomWs n w h'+            master = head ws+            other  = tail ws+            bottomWs = take m other+            rightWs = drop m other+            masterRect = cmaster n m cx cy rect+            bottomRect = cbottom cy rect+            rightRect  = cright cx cy rect++-- | Calculate how many windows must be placed at bottom+calcBottomWs :: Int -> Dimension -> Dimension -> Int+calcBottomWs n w h' = case n of+                        1 -> 0+                        2 -> 1+                        3 -> 2+                        4 -> 2+                        _ -> (fromIntegral w)*(n-1) `div` fromIntegral (h'+(fromIntegral w))++-- | Calculate rectangle for master window+cmaster:: Int -> Int -> Float -> Float -> Rectangle -> Rectangle+cmaster n m cx cy (Rectangle x y sw sh) = Rectangle x y w h+    where w = if (n > m+1) then+                round (fromIntegral sw*cx)+              else+                sw+          h = if (n > 1) then+                round (fromIntegral sh*cy)+              else+                sh++-- | Calculate rectangle for bottom windows+cbottom:: Float -> Rectangle -> Rectangle+cbottom cy (Rectangle sx sy sw sh) = Rectangle sx y sw h+    where h = round (fromIntegral sh*(1-cy))+          y = round (fromIntegral sh*cy+(fromIntegral sy))++-- | Calculate rectangle for right windows+cright:: Float -> Float -> Rectangle -> Rectangle+cright cx cy (Rectangle sx sy sw sh) = Rectangle x sy w h+    where w = round (fromIntegral sw*(1-cx))+          x = round (fromIntegral sw*cx+(fromIntegral sx))+          h = round (fromIntegral sh*cy)++-- | Divide bottom rectangle between windows +divideBottom :: Rectangle -> [a] -> [(a, Rectangle)]+divideBottom (Rectangle x y w h) ws = zip ws rects+    where n = length ws+          oneW = fromIntegral w `div` n+          oneRect = Rectangle x y (fromIntegral oneW) h+          rects = take n $ iterate (shiftR (fromIntegral oneW)) oneRect++-- | Divide right rectangle between windows+divideRight :: Rectangle -> [a] -> [(a, Rectangle)]+divideRight (Rectangle x y w h) ws = if (n==0) then [] else zip ws rects+    where n = length ws+          oneH = fromIntegral h `div` n+          oneRect = Rectangle x y w (fromIntegral oneH)+          rects = take n $ iterate (shiftB (fromIntegral oneH)) oneRect++-- | Shift rectangle right +shiftR :: Position -> Rectangle -> Rectangle+shiftR s (Rectangle x y w h) = Rectangle (x+s) y w h++-- | Shift rectangle bottom+shiftB :: Position -> Rectangle -> Rectangle+shiftB s (Rectangle x y w h) = Rectangle x (y+s) w h++
+ XMonad/Layout/PerWorkspace.hs view
@@ -0,0 +1,127 @@+{-# 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: use layouts and apply+-- layout modifiers selectively, depending on the workspace.+-----------------------------------------------------------------------------++module XMonad.Layout.PerWorkspace+    ( -- * Usage+      -- $usage+      PerWorkspace,+      onWorkspace, onWorkspaces,+      modWorkspace, modWorkspaces+    ) where++import XMonad+import qualified XMonad.StackSet as W++import XMonad.Layout.LayoutModifier++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 = modWorkspace "baz" m1 $  -- apply layout modifier m1 to all layouts on workspace "baz"+-- >              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 ||| ...)@, and @m1@ can be any layout modifier, i.e. a+-- function of type @(l a -> ModifiedLayout lm l a)@.+--+-- 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++-- | 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 = onWorkspaces [wsId]++-- | 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 False l1 l2++-- | Specify a layout modifier to apply to a particular workspace; layouts+--   on all other workspaces will remain unmodified.+modWorkspace :: (LayoutClass l a)+             => WorkspaceId                     -- ^ tag of the workspace to match+             -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching workspace+             -> l a                             -- ^ the base layout+             -> PerWorkspace (ModifiedLayout lm l) l a+modWorkspace wsId = modWorkspaces [wsId]++-- | Specify a layout modifier to apply to a particular set of+--   workspaces; layouts on all other workspaces will remain+--   unmodified.+modWorkspaces :: (LayoutClass l a)+              => [WorkspaceId]                   -- ^ tags of the workspaces to match+              -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching workspaces+              -> l a                             -- ^ the base layout+              -> PerWorkspace (ModifiedLayout lm l) l a+modWorkspaces wsIds f l = PerWorkspace wsIds False (f l) l++-- | 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. We save the layout choice in+-- the Bool, to be used to implement description.+data PerWorkspace l1 l2 a = PerWorkspace [WorkspaceId]+                                         Bool+                                         (l1 a)+                                         (l2 a)+    deriving (Read, Show)++instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerWorkspace l1 l2) a where+    runLayout (W.Workspace i p@(PerWorkspace wsIds _ lt lf) ms) r+        | i `elem` wsIds = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r+                              return (wrs, Just $ mkNewPerWorkspaceT p mlt')+        | otherwise      = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r+                              return (wrs, Just $ mkNewPerWorkspaceF p mlt')++    handleMessage (PerWorkspace wsIds bool lt lf) m+        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerWorkspace wsIds bool nt lf)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ PerWorkspace wsIds bool lt nf)++    description (PerWorkspace _ True  l1 _) = description l1+    description (PerWorkspace _ _     _ l2) = description l2++-- | Construct new PerWorkspace values with possibly modified layouts.+mkNewPerWorkspaceT :: PerWorkspace l1 l2 a -> Maybe (l1 a) ->+                      PerWorkspace l1 l2 a+mkNewPerWorkspaceT (PerWorkspace wsIds _ lt lf) mlt' =+    (\lt' -> PerWorkspace wsIds True lt' lf) $ fromMaybe lt mlt'++mkNewPerWorkspaceF :: PerWorkspace l1 l2 a -> Maybe (l2 a) ->+                      PerWorkspace l1 l2 a+mkNewPerWorkspaceF (PerWorkspace wsIds _ lt lf) mlf' =+    (\lf' -> PerWorkspace wsIds False lt lf') $ fromMaybe lf mlf'+
+ XMonad/Layout/PositionStoreFloat.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, PatternGuards #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.PositionStoreFloat+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.PositionStoreFloat+    ( positionStoreFloat+    ) where++import XMonad+import XMonad.PositionStore+import qualified XMonad.StackSet as S+import XMonad.Layout.WindowArranger+import Control.Monad(when)+import Data.Maybe(isJust)+import Data.List(nub)++positionStoreFloat :: PositionStoreFloat a+positionStoreFloat = PSF (Nothing, [])++data PositionStoreFloat a = PSF (Maybe Rectangle, [a]) deriving (Show, Read)+instance LayoutClass PositionStoreFloat Window where+    description _ = "PSF"+    doLayout (PSF (maybeChange, paintOrder)) sr (S.Stack w l r) = do+            XState { positionStore = posStore } <- get+            let wrs = map (\w' -> (w', pSQ posStore w' sr)) (reverse l ++ r)+            let focused = case maybeChange of+                            Nothing -> (w, pSQ posStore w sr)+                            Just changedRect -> (w, changedRect)+            let wrs' = focused : wrs+            let paintOrder' = nub (w : paintOrder)+            when (isJust maybeChange) $ do+                updatePositionStore focused sr+            return (reorder wrs' paintOrder', Just $ PSF (Nothing, paintOrder'))+        where+            pSQ posStore w' sr' = case (posStoreQuery posStore w' sr') of+                                    Just rect   -> rect+                                    Nothing     -> (Rectangle 50 50 200 200)  -- should usually not happen+    pureMessage (PSF (_, paintOrder)) m+        | Just (SetGeometry rect) <- fromMessage m =+            Just $ PSF (Just rect, paintOrder)+        | otherwise = Nothing++updatePositionStore :: (Window, Rectangle) -> Rectangle -> X ()+updatePositionStore (w, rect) sr = modifyPosStore (\ps ->+                                            posStoreInsert ps w rect sr)++reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]+reorder wrs order =+    let ordered = concat $ map (pickElem wrs) order+        rest = filter (\(w, _) -> not (w `elem` order)) wrs+    in ordered ++ rest+    where+        pickElem list e = case (lookup e list) of+                                Just result -> [(e, result)]+                                Nothing -> []
+ XMonad/Layout/Reflect.hs view
@@ -0,0 +1,115 @@+{-# OPTIONS_GHC -fglasgow-exts #-}++-- for now, use -fglasgow-exts for compatibility with ghc 6.6, which chokes+-- on some of the LANGUAGE pragmas below+{- LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances -}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Reflect+-- Copyright   :  (c) Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Reflect a layout horizontally or vertically.+-----------------------------------------------------------------------------++module XMonad.Layout.Reflect (+                               -- * Usage+                               -- $usage++                               reflectHoriz, reflectVert,+                               REFLECTX(..), REFLECTY(..)++                             ) where++import XMonad.Core+import Graphics.X11 (Rectangle(..), Window)+import Control.Arrow (second)++import XMonad.Layout.LayoutModifier+import XMonad.Layout.MultiToggle++-- $usage+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Layout.Reflect+--+-- and modifying your layoutHook as follows (for example):+--+-- > layoutHook = reflectHoriz $ Tall 1 (3/100) (1/2)  -- put master pane on the right+--+-- 'reflectHoriz' and 'reflectVert' can be applied to any sort of+-- layout (including Mirrored layouts) and will simply flip the+-- physical layout of the windows vertically or horizontally.+--+-- "XMonad.Layout.MultiToggle" transformers are also provided for+-- toggling layouts between reflected\/non-reflected with a keybinding.+-- To use this feature, you will also need to import the MultiToggle+-- module:+--+-- > import XMonad.Layout.MultiToggle+--+-- Next, add one or more toggles to your layout.  For example, to allow+-- separate toggling of both vertical and horizontal reflection:+--+-- > layoutHook = mkToggle (single REFLECTX) $+-- >              mkToggle (single REFLECTY) $+-- >                (tiled ||| Mirror tiled ||| ...) -- whatever layouts you use+--+-- Finally, add some keybindings to do the toggling, for example:+--+-- > , ((modMask x .|. controlMask, xK_x), sendMessage $ Toggle REFLECTX)+-- > , ((modMask x .|. controlMask, xK_y), sendMessage $ Toggle REFLECTY)+--++-- | Apply a horizontal reflection (left \<--\> right) to a+--   layout.+reflectHoriz :: l a -> ModifiedLayout Reflect l a+reflectHoriz = ModifiedLayout (Reflect Horiz)++-- | Apply a vertical reflection (top \<--\> bottom) to a+--   layout.+reflectVert :: l a -> ModifiedLayout Reflect l a+reflectVert = ModifiedLayout (Reflect Vert)++data ReflectDir = Horiz | Vert+  deriving (Read, Show)++-- | Given an axis of reflection and the enclosing rectangle which+--   contains all the laid out windows, transform a rectangle+--   representing a window into its flipped counterpart.+reflectRect :: ReflectDir -> Rectangle -> Rectangle -> Rectangle+reflectRect Horiz (Rectangle sx _ sw _) (Rectangle rx ry rw rh) =+  Rectangle (2*sx + fi sw - rx - fi rw) ry rw rh+reflectRect Vert (Rectangle _ sy _ sh) (Rectangle rx ry rw rh) =+  Rectangle rx (2*sy + fi sh - ry - fi rh) rw rh++fi :: (Integral a, Num b) => a -> b+fi = fromIntegral+++data Reflect a = Reflect ReflectDir deriving (Show, Read)++instance LayoutModifier Reflect a where++    -- reflect all the generated Rectangles.+    pureModifier (Reflect d) r _ wrs = (map (second $ reflectRect d r) wrs, Just $ Reflect d)++    modifierDescription (Reflect d) = "Reflect" ++ xy+      where xy = case d of { Horiz -> "X" ; Vert -> "Y" }+++-------- instances for MultiToggle ------------------++data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable)+data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable)++instance Transformer REFLECTX Window where+    transform REFLECTX x k = k (reflectHoriz x)++instance Transformer REFLECTY Window where+    transform REFLECTY x k = k (reflectVert x)
+ XMonad/Layout/ResizableTile.hs view
@@ -0,0 +1,104 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ResizableTile+-- Copyright   :  (c) MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  MATSUYAMA Tomohiro <t.matsuyama.pub@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- More useful tiled layout that allows you to change a width\/height of window.+--+-----------------------------------------------------------------------------++module XMonad.Layout.ResizableTile (+                                    -- * Usage+                                    -- $usage+                                    ResizableTall(..), MirrorResize(..)+                                   ) where++import XMonad hiding (tile, splitVertically, splitHorizontallyBy)+import qualified XMonad.StackSet as W+import Control.Monad+import qualified Data.Map as M+import Data.List ((\\))++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ResizableTile+--+-- Then edit your @layoutHook@ by adding the ResizableTile layout:+--+-- > myLayouts =  ResizableTall 1 (3/100) (1/2) [] ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You may also want to add the following key bindings:+--+-- > , ((modMask x,               xK_a), sendMessage MirrorShrink)+-- > , ((modMask x,               xK_z), sendMessage MirrorExpand)+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++data MirrorResize = MirrorShrink | MirrorExpand deriving Typeable+instance Message MirrorResize++data ResizableTall a = ResizableTall Int Rational Rational [Rational] deriving (Show, Read)+instance LayoutClass ResizableTall a where+    doLayout (ResizableTall nmaster _ frac mfrac) r =+        return . (\x->(x,Nothing)) .+        ap zip (tile frac (mfrac ++ repeat 1) r nmaster . length) . W.integrate+    handleMessage (ResizableTall nmaster delta frac mfrac) m =+        do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset+           fs <- (M.keys . W.floating) `fmap` gets windowset+           return $ ms >>= unfloat fs >>= handleMesg+        where handleMesg s = msum [fmap resize (fromMessage m)+                                  ,fmap (\x -> mresize x s) (fromMessage m)+                                  ,fmap incmastern (fromMessage m)]+              unfloat fs s = if W.focus s `elem` fs+                               then Nothing+                               else Just (s { W.up = (W.up s) \\ fs+                                            , W.down = (W.down s) \\ fs })+              resize Shrink = ResizableTall nmaster delta (max 0 $ frac-delta) mfrac+              resize Expand = ResizableTall nmaster delta (min 1 $ frac+delta) mfrac+              mresize MirrorShrink s = mresize' s delta+              mresize MirrorExpand s = mresize' s (0-delta)+              mresize' s d = let n = length $ W.up s+                                 total = n + (length $ W.down s) + 1+                                 pos = if n == (nmaster-1) || n == (total-1) then n-1 else n+                                 mfrac' = modifymfrac (mfrac ++ repeat 1) d pos+                             in ResizableTall nmaster delta frac $ take total mfrac'+              modifymfrac [] _ _ = []+              modifymfrac (f:fx) d n | n == 0    = f+d : fx+                                     | otherwise = f : modifymfrac fx d (n-1)+              incmastern (IncMasterN d) = ResizableTall (max 0 (nmaster+d)) delta frac mfrac+    description _ = "ResizableTall"++tile :: Rational -> [Rational] -> Rectangle -> Int -> Int -> [Rectangle]+tile f mf r nmaster n = if n <= nmaster || nmaster == 0+    then splitVertically mf n r+    else splitVertically mf nmaster r1 ++ splitVertically (drop nmaster mf) (n-nmaster) r2 -- two columns+  where (r1,r2) = splitHorizontallyBy f r++splitVertically :: RealFrac r => [r] -> Int -> Rectangle -> [Rectangle]+splitVertically [] _ r = [r]+splitVertically _ n r | n < 2 = [r]+splitVertically (f:fx) n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :+    splitVertically fx (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))+  where smallh = floor $ fromIntegral (sh `div` fromIntegral n) * f --hmm, this is a fold or map.++splitHorizontallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)+splitHorizontallyBy f (Rectangle sx sy sw sh) =+    ( Rectangle sx sy leftw sh+    , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)+  where leftw = floor $ fromIntegral sw * f
+ XMonad/Layout/ResizeScreen.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ResizeScreen+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout transformer to have a layout respect a given screen+-- geometry. Mostly used with "Decoration" (the Horizontal and the+-- Vertical version will react to SetTheme and change their dimension+-- accordingly.+-----------------------------------------------------------------------------++module XMonad.Layout.ResizeScreen+    ( -- * Usage:+      -- $usage+      resizeHorizontal, resizeVertical+    , resizeHorizontalRight, resizeVerticalBottom+    , withNewRectangle+    , ResizeScreen (..)+    ) where++import XMonad+import XMonad.Layout.Decoration++-- $usage+-- You can use this module by importing it into your+-- @~\/.xmonad\/xmonad.hs@ file:+--+-- > import XMonad.Layout.ResizeScreen+--+-- and modifying your layoutHook as follows (for example):+--+-- > layoutHook = resizeHorizontal 40 Full+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++resizeHorizontal :: Int -> l a -> ModifiedLayout ResizeScreen l a+resizeHorizontal i = ModifiedLayout (ResizeScreen L i)++resizeVertical :: Int -> l a -> ModifiedLayout ResizeScreen l a+resizeVertical i = ModifiedLayout (ResizeScreen T i)++resizeHorizontalRight :: Int -> l a -> ModifiedLayout ResizeScreen l a+resizeHorizontalRight i = ModifiedLayout (ResizeScreen R i)++resizeVerticalBottom :: Int -> l a -> ModifiedLayout ResizeScreen l a+resizeVerticalBottom i = ModifiedLayout (ResizeScreen B i)++withNewRectangle  :: Rectangle -> l a -> ModifiedLayout ResizeScreen l a+withNewRectangle r = ModifiedLayout (WithNewScreen r)++data ResizeScreen a = ResizeScreen ResizeMode Int+                    | WithNewScreen Rectangle+                      deriving (Read, Show)++data ResizeMode = T | B | L | R deriving (Read, Show)++instance LayoutModifier ResizeScreen a where+    modifyLayout m ws rect@(Rectangle x y w h)+        | ResizeScreen L i <- m = resize $ Rectangle (x + fi i) y (w - fi i) h+        | ResizeScreen R i <- m = resize $ Rectangle x          y (w - fi i) h+        | ResizeScreen T i <- m = resize $ Rectangle x (y + fi i) w (h - fi i)+        | ResizeScreen B i <- m = resize $ Rectangle x  y         w (h - fi i)+        | WithNewScreen  r <- m = resize r+        | otherwise             = resize rect+       where resize nr = runLayout ws nr++    pureMess (ResizeScreen d _) m+        | Just (SetTheme t) <- fromMessage m = Just $ ResizeScreen d (fi $ decoHeight t)+    pureMess _ _ = Nothing
+ XMonad/Layout/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/ShowWName.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.ShowWName+-- Copyright   :  (c) Andrea Rossato 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- This is a layout modifier that will show the workspace name+-----------------------------------------------------------------------------++module XMonad.Layout.ShowWName+    ( -- * Usage+      -- $usage+      showWName+    , showWName'+    , defaultSWNConfig+    , SWNConfig(..)+    ) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.LayoutModifier+import XMonad.Util.Font+import XMonad.Util.Timer+import XMonad.Util.XUtils++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.ShowWName+-- > myLayout = layoutHook defaultConfig+-- > main = xmonad defaultConfig { layoutHook = showWName myLayout }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | A layout modifier to show the workspace name when switching+showWName :: l a -> ModifiedLayout ShowWName l a+showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing)++-- | A layout modifier to show the workspace name when switching. It+-- is possible to provide a costum configuration.+showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a+showWName' c = ModifiedLayout (SWN True c Nothing)++type ShowWNState = Maybe (TimerId, Window)+data ShowWName a = SWN Bool SWNConfig ShowWNState deriving (Read, Show)++data SWNConfig =+    SWNC { swn_font    :: String   -- ^ Font name+         , swn_bgcolor :: String   -- ^ Background color+         , swn_color   :: String   -- ^ String color+         , swn_fade    :: Rational -- ^ Time in seconds of the name visibility+    } deriving (Read, Show)++defaultSWNConfig :: SWNConfig+defaultSWNConfig =+    SWNC { swn_font    = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+         , swn_bgcolor = "black"+         , swn_color   = "white"+         , swn_fade    = 1+         }++instance LayoutModifier ShowWName a where+    redoLayout      sn r _ wrs = doShow sn r wrs++    handleMess (SWN _ c (Just (i,w))) m+        | Just e    <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)+        | Just Hide <- fromMessage m = do deleteWindow w+                                          return . Just $ SWN True c Nothing++    handleMess (SWN _ c s) m+        | Just Hide <- fromMessage m = return . Just $ SWN True c s+        | otherwise                  = return Nothing++doShow :: ShowWName a -> Rectangle -> [(a,Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))+doShow (SWN True  c (Just (_,w))) r wrs = deleteWindow w >> flashName c r wrs+doShow (SWN True  c  Nothing    ) r wrs = flashName c r wrs+doShow (SWN False _  _          ) _ wrs = return (wrs, Nothing)++flashName :: SWNConfig -> Rectangle -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ShowWName a))+flashName c (Rectangle _ _ wh ht) wrs = do+  d <- asks display+  n <- withWindowSet (return . S.currentTag)+  f <- initXMF (swn_font c)+  width   <- textWidthXMF d f n+  (as,ds) <- textExtentsXMF f n+  let hight = as + ds+      y     = (fi ht - hight + 2) `div` 2+      x     = (fi wh - width + 2) `div` 2+  w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight)) Nothing "" True+  showWindow w+  paintAndWrite w f (fi width) (fi hight) 0 "" "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n]+  releaseXMF f+  io $ sync d False+  i <- startTimer (swn_fade c)+  return (wrs, Just $ SWN False c $ Just (i,w))
+ XMonad/Layout/SimpleDecoration.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.SimpleDecoration+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier for adding simple decorations to the windows of a+-- given layout. The decorations are in the form of ion-like tabs+-- for window titles.+--+-----------------------------------------------------------------------------++module XMonad.Layout.SimpleDecoration+    ( -- * Usage:+      -- $usage+      simpleDeco+    , Theme (..)+    , defaultTheme+    , SimpleDecoration (..)+    , shrinkText, CustomShrink(CustomShrink)+    , Shrinker(..)+    ) where++import XMonad+import XMonad.Layout.Decoration++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.SimpleDecoration+--+-- Then edit your @layoutHook@ by adding the SimpleDecoration decoration to+-- your layout:+--+-- > myL = simpleDeco shrinkText defaultTheme (layoutHook defaultConfig)+-- > main = xmonad defaultConfig { layoutHook = myL }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You can also edit the default configuration options.+--+-- > mySDConfig = defaultTheme { inactiveBorderColor = "red"+-- >                                  , inactiveTextColor   = "red"}+--+-- and+--+-- > myL = dwmStyle shrinkText mySDConfig (layoutHook defaultTheme)++-- | Add simple decorations to windows of a layout.+simpleDeco :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration SimpleDecoration s) l a+simpleDeco s c = decoration s c $ Simple True++data SimpleDecoration a = Simple Bool deriving (Show, Read)++instance Eq a => DecorationStyle SimpleDecoration a where+    describeDeco _ = "Simple"+    shrink (Simple b) (Rectangle _ _ _ dh) r@(Rectangle x y w h) =+        if b then Rectangle x (y + fi dh) w (h - dh) else r+    pureDecoration (Simple b) wh ht _ s _ (w,Rectangle x y wid _) =+        if isInStack s w+        then if b+             then Just $ Rectangle x  y          nwh ht+             else Just $ Rectangle x (y - fi ht) nwh ht+        else Nothing+            where nwh = min wid wh
+ XMonad/Layout/SimpleFloat.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.SimpleFloat+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A basic floating layout.+-----------------------------------------------------------------------------++module XMonad.Layout.SimpleFloat+    ( -- * Usage:+      -- $usage+      simpleFloat+    , simpleFloat'+    , SimpleDecoration (..)+    , SimpleFloat (..)+    , shrinkText, CustomShrink(CustomShrink)+    , Shrinker(..)+    ) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Actions.MouseResize+import XMonad.Layout.Decoration+import XMonad.Layout.SimpleDecoration+import XMonad.Layout.WindowArranger++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.SimpleFloat+--+-- Then edit your @layoutHook@ by adding the SimpleFloat layout:+--+-- > myLayouts = simpleFloat ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | A simple floating layout where every window is placed according+-- to the window's initial attributes.+--+-- This version is decorated with the 'SimpleDecoration' style.+simpleFloat :: Eq a => ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)+               (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+simpleFloat = decoration shrinkText defaultTheme (Simple False) (mouseResize $ windowArrangeAll $ SF 20)++-- | Same as 'simpleFloat', but with the possibility of setting a+-- custom shrinker and a custom theme.+simpleFloat' :: (Eq a, Shrinker s) => s -> Theme ->+               ModifiedLayout (Decoration SimpleDecoration s)+               (ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a+simpleFloat' s c = decoration s c (Simple False) (mouseResize $ windowArrangeAll $ SF (decoHeight c))++data SimpleFloat a = SF Dimension deriving (Show, Read)+instance LayoutClass SimpleFloat Window where+    description _ = "Float"+    doLayout (SF i) sc (S.Stack w l r) = do+        wrs <- mapM (getSize i sc) (w : reverse l ++ r)+        return (wrs, Nothing)++getSize :: Dimension -> Rectangle -> Window -> X (Window,Rectangle)+getSize i (Rectangle rx ry _ _) w = do+  d  <- asks display+  bw <- asks (borderWidth . config)+  wa <- io $ getWindowAttributes d w+  let ny = ry + fi i+      x  =  max rx $ fi $ wa_x wa+      y  =  max ny $ fi $ wa_y wa+      wh = (fi $ wa_width  wa) + (bw * 2)+      ht = (fi $ wa_height wa) + (bw * 2)+  return (w, Rectangle x y wh ht)
+ XMonad/Layout/Simplest.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Simplest+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A very simple layout. The simplest, afaik.+-----------------------------------------------------------------------------++module XMonad.Layout.Simplest+    ( -- * Usage:+      -- $usage+      Simplest (..)+    ) where++import XMonad+import qualified XMonad.StackSet as S++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Simplest+--+-- Then edit your @layoutHook@ by adding the Simplest layout:+--+-- > myLayouts = Simplest ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++data Simplest a = Simplest deriving (Show, Read)+instance LayoutClass Simplest a where+    pureLayout Simplest rec (S.Stack w l r) = zip (w : reverse l ++ r) (repeat rec)
+ XMonad/Layout/SimplestFloat.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.SimplestFloat+-- Copyright   :  (c) 2008 Jussi Mäki+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  joamaki@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A basic floating layout like SimpleFloat but without the decoration.+-----------------------------------------------------------------------------++module XMonad.Layout.SimplestFloat+    ( -- * Usage:+      -- $usage+      simplestFloat+    , SimplestFloat+    ) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.WindowArranger+import XMonad.Layout.LayoutModifier++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.SimplestFloat+--+-- Then edit your @layoutHook@ by adding the SimplestFloat layout:+--+-- > myLayouts = simplestFloat ||| Full ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | A simple floating layout where every window is placed according+-- to the window's initial attributes.+simplestFloat :: Eq a => (ModifiedLayout WindowArranger SimplestFloat) a+simplestFloat = (windowArrangeAll $ SF)++data SimplestFloat a = SF deriving (Show, Read)+instance LayoutClass SimplestFloat Window where+    doLayout SF sc (S.Stack w l r) = do wrs <- mapM (getSize sc) (w : reverse l ++ r)+                                        return (wrs, Nothing)+    description _ = "SimplestFloat"++getSize :: Rectangle -> Window -> X (Window,Rectangle)+getSize (Rectangle rx ry _ _) w = do+  d  <- asks display+  bw <- asks (borderWidth . config)+  wa <- io $ getWindowAttributes d w+  let x  =  max rx $ fi $ wa_x wa+      y  =  max ry $ fi $ wa_y wa+      wh = (fi $ wa_width  wa) + (bw * 2)+      ht = (fi $ wa_height wa) + (bw * 2)+  return (w, Rectangle x y wh ht)+  where+    fi x = fromIntegral x
+ XMonad/Layout/Spiral.hs view
@@ -0,0 +1,122 @@+{-# 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+--+-- 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+--+-- Then edit your @layoutHook@ by adding the Spiral layout:+--+-- > myLayouts =  spiral (6/7) ||| 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..]++-- | A spiral layout.  The parameter controls the size ratio between+--   successive windows in the spiral.  Sensible values range from 0+--   up to the aspect ratio of your monitor (often 4\/3).+--+--   By default, the spiral is counterclockwise, starting to the east.+--   See also 'spiralWithDir'.+spiral :: Rational -> SpiralWithDir a+spiral = spiralWithDir East CW++-- | Create a spiral layout, specifying the starting cardinal direction,+--   the spiral direction (clockwise or counterclockwise), and the+--   size ratio.+spiralWithDir :: Direction -> Rotation -> Rational -> SpiralWithDir a+spiralWithDir = SpiralWithDir++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  :  none+-- 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/StackTile.hs view
@@ -0,0 +1,64 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.StackTile+-- Copyright   :  (c) Rickard Gustafsson <acura@allyourbase.se>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Rickard Gustafsson <acura@allyourbase.se>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A stacking layout, like dishes but with the ability to resize master pane.+-- Moastly usefull on small screens.+--+-----------------------------------------------------------------------------++module XMonad.Layout.StackTile (+                                    -- * Usage+                                    -- $usage+                                    StackTile(..)+                                   ) where++import XMonad hiding (tile)+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.StackTile+--+-- Then edit your @layoutHook@ by adding the StackTile layout:+--+-- > myLayouts =  StackTile 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"+--+data StackTile a = StackTile !Int !Rational !Rational deriving (Show, Read)++instance LayoutClass StackTile a where+    pureLayout (StackTile nmaster _ frac) r s = zip ws rs+      where ws = W.integrate s+            rs = tile frac r nmaster (length ws)++    pureMessage (StackTile nmaster delta frac) m =+            msum [fmap resize     (fromMessage m)+                 ,fmap incmastern (fromMessage m)]++      where resize Shrink             = StackTile nmaster delta (max 0 $ frac-delta)+            resize Expand             = StackTile nmaster delta (min 1 $ frac+delta)+            incmastern (IncMasterN d) = StackTile (max 0 (nmaster+d)) delta frac++    description _ = "StackTile"++tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]+tile f r nmaster n = if n <= nmaster || nmaster == 0+    then splitHorizontally n r+    else splitHorizontally nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns+  where (r1,r2) = splitVerticallyBy f r
+ XMonad/Layout/SubLayouts.hs view
@@ -0,0 +1,450 @@+{-# LANGUAGE PatternGuards, ParallelListComp, DeriveDataTypeable, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.SubLayouts+-- Copyright   :  (c) 2009 Adam Vogt+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  vogt.adam@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout combinator that allows layouts to be nested.+--+-----------------------------------------------------------------------------++module XMonad.Layout.SubLayouts (+    -- * Usage+    -- $usage+    subLayout,+    subTabbed,++    pushGroup, pullGroup,+    pushWindow, pullWindow,+    onGroup, toSubl, mergeDir,++    GroupMsg(..),+    Broadcast(..),++    defaultSublMap,++    -- * Todo+    -- $todo+    )+    where++import XMonad.Layout.Decoration(Decoration, DefaultShrinker)+import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout,+                                    redoLayout),+                                    ModifiedLayout(..))+import XMonad.Layout.Simplest(Simplest(..))+import XMonad.Layout.Tabbed(defaultTheme, shrinkText,+                            TabbedDecoration, addTabs)+import XMonad.Layout.WindowNavigation(Direction, Navigate(Apply))+import XMonad.Util.Invisible(Invisible(..))+import XMonad+import Control.Applicative((<$>))+import Control.Arrow(Arrow(second, (&&&)))+import Control.Monad(Monad(return), Functor(..),+                     MonadPlus(mplus), (=<<), sequence, foldM, guard, when, join)+import Data.Function((.), ($), flip, id, on)+import Data.List((++), foldr, filter, map, concatMap, elem,+                 notElem, null, nubBy, (\\), find)+import Data.Maybe(Maybe(..), maybe, fromMaybe, listToMaybe,+                  mapMaybe)+import Data.Traversable(sequenceA)++import qualified XMonad.Layout.BoringWindows as B+import qualified XMonad.StackSet as W+import qualified Data.Map as M+import Data.Map(Map)++-- $todo+--  'subTabbed' works well, but it would be more uniform to avoid the use of+--  addTabs, with the sublayout being Simplest (but+--  'XMonad.Layout.Tabbed.simpleTabbed' is this...).  The only thing to be+--  gained by fixing this issue is the ability to mix and match decoration+--  styles. Better compatibility with some other layouts of which I am not+--  aware could be another benefit.+--+--  'simpleTabbed' (and other decorated layouts) fail horibly when used as+--  subLayouts:+--+--    * decorations stick around: layout is run after being told to Hide+--+--    * mouse events do not change focus: the group-ungroup does not respect+--      the focus changes it wants?+--+--    * sending ReleaseResources before running it makes xmonad very slow, and+--      still leaves borders sticking around+--+--  Issue 288: "XMonad.Layout.ResizableTile" assumes that its environment+--  contains only the windows it is running: should sublayouts be run in a+--  restricted environment that is then merged back?++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.SubLayouts+-- > import XMonad.Layout.WindowNavigation+--+-- Using BoringWindows is optional and it allows you to add a keybinding to+-- skip over the non-visible windows.+--+-- > import XMonad.Layout.BoringWindows+--+-- Then edit your @layoutHook@ by adding the subTabbed layout modifier:+--+-- > myLayouts = windowNavigation $ subTabbed $ boringWindows $+-- >                        Tall 1 (3/100) (1/2) ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- "XMonad.Layout.WindowNavigation" is used to specify which windows to merge,+-- and it is not integrated into the modifier because it can be configured, and+-- works best as the outer modifier.+--+-- Then to your keybindings add:+--+--  > , ((modMask .|. controlMask, xK_h), sendMessage $ pullGroup L)+--  > , ((modMask .|. controlMask, xK_l), sendMessage $ pullGroup R)+--  > , ((modMask .|. controlMask, xK_k), sendMessage $ pullGroup U)+--  > , ((modMask .|. controlMask, xK_j), sendMessage $ pullGroup D)+--  >+--  > , ((modMask .|. controlMask, xK_m), withFocused (sendMessage . MergeAll))+--  > , ((modMask .|. controlMask, xK_u), withFocused (sendMessage . UnMerge))+--  >+--  > , ((modMask .|. controlMask, xK_period), onGroup W.focusUp')+--  > , ((modMask .|. controlMask, xK_comma), onGroup W.focusDown')+--+--  These additional keybindings require the optional+--  "XMonad.Layout.BoringWindows" layoutModifier. The focus will skip over the+--  windows that are not focused in each sublayout.+--+--  > , ((modMask, xK_j), focusDown)+--  > , ((modMask, xK_k), focusUp)+--+--  A 'submap' can be used to make modifying the sublayouts using 'onGroup' and+--  'toSubl' simpler:+--+--  > ,((modm, xK_s), submap $ defaultSublMap conf)+--+--  /NOTE:/ is there some reason that @asks config >>= submap . defaultSublMap@+--  could not be used in the keybinding instead? It avoids having to explicitly+--  pass the conf.+--+-- For more detailed instructions, see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+-- "XMonad.Doc.Extending#Adding_key_bindings"++-- | The main layout modifier arguments:+--+--  [@nextLayout@] When a new group is formed, use the layout @sl@ after+--  skipping that number of layouts. Specify a finite list and groups that do+--  not have a corresponding index get the first choice in @sls@+--+--  [@sl@] The single layout given to be run as a sublayout.+--+--  [@x@] The layout that determines the rectangles that the groups get.+--+--  Ex. The second group is Tall, the third is Circle, all others are tabbed+--  with:+--+--  > myLayout = addTabs shrinkText defaultTheme+--  >          $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle)+--  >          $ Tall 1 0.2 0.5 ||| Full+subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a+subLayout nextLayout sl x = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) x++-- | 'subLayout' but use 'XMonad.Layout.Tabbed.addTabs' to add decorations.+subTabbed :: (Eq a, LayoutModifier (Sublayout Simplest) a, LayoutClass l a) =>+    l a -> ModifiedLayout (Decoration TabbedDecoration DefaultShrinker)+                          (ModifiedLayout (Sublayout Simplest) l) a+subTabbed  x = addTabs shrinkText defaultTheme $ subLayout [] Simplest x++-- | @defaultSublMap@ is an attempt to create a set of keybindings like the+-- defaults ones but to be used as a 'submap' for sending messages to the+-- sublayout.+defaultSublMap :: XConfig l -> Map (KeyMask, KeySym) (X ())+defaultSublMap (XConfig { modMask = modm }) = M.fromList+         [((modm, xK_space), toSubl NextLayout),+          ((modm, xK_j), onGroup W.focusDown'),+          ((modm, xK_k), onGroup W.focusUp'),+          ((modm, xK_h), toSubl Shrink),+          ((modm, xK_l), toSubl Expand),+          ((modm, xK_Tab), onGroup W.focusDown'),+          ((modm .|. shiftMask, xK_Tab), onGroup W.focusUp'),+          ((modm, xK_m), onGroup focusMaster'),+          ((modm, xK_comma), toSubl $ IncMasterN 1),+          ((modm, xK_period), toSubl $ IncMasterN (-1)),+          ((modm, xK_Return), onGroup swapMaster')+         ]+        where+         -- should these go into XMonad.StackSet?+         focusMaster' st = let (f:fs) = W.integrate st+            in W.Stack f [] fs+         swapMaster' (W.Stack f u d) = W.Stack f [] $ reverse u ++ d++data Sublayout l a = Sublayout+    { delayMess :: Invisible [] (SomeMessage,a)+                          -- ^ messages are handled when running the layout,+                          -- not in the handleMessage, I'm not sure that this+                          -- is necessary+    , def :: ([Int], l a) -- ^ how many NextLayout messages to send to newly+                          -- populated layouts. If there is no corresponding+                          -- index, then don't send any.+    , subls :: [(l a,W.Stack a)]+                          -- ^ The sublayouts and the stacks they manage+    }+    deriving (Read,Show)++-- | Groups assumes this invariant:+--     M.keys gs == map W.focus (M.elems gs)  (ignoring order)+--     All windows in the workspace are in the Map+--+-- The keys are visible windows, the rest are hidden.+--+-- This representation probably simplifies the internals of the modifier.+type Groups a = Map a (W.Stack a)++-- | GroupMsg take window parameters to determine which group the action should+-- be applied to+data GroupMsg a+    = UnMerge a -- ^ free the focused window from its tab stack+    | UnMergeAll a+                -- ^ separate the focused group into singleton groups+    | Merge a a -- ^ merge the first group into the second group+    | MergeAll a+                -- ^ make one large group, keeping a focused+    | WithGroup (W.Stack a -> X (W.Stack a)) a+    | SubMessage SomeMessage  a+                -- ^ the sublayout with the given window will get the message+    deriving (Typeable)++-- | merge the window that would be focused by the function when applied to the+-- W.Stack of all windows, with the current group removed. The given window+-- should be focused by a sublayout. Example usage: @withFocused (sendMessage .+-- mergeDir W.focusDown')@+mergeDir :: (W.Stack Window -> W.Stack Window) -> Window -> GroupMsg Window+mergeDir f w = WithGroup g w+ where g cs = do+        let onlyOthers = W.filter (`notElem` W.integrate cs)+        flip whenJust (sendMessage . Merge (W.focus cs) . W.focus . f)+            =<< fmap (onlyOthers =<<) currentStack+        return cs++data Broadcast = Broadcast SomeMessage -- ^ send a message to all sublayouts+    deriving (Typeable)++instance Message Broadcast+instance Typeable a => Message (GroupMsg a)++-- | pullGroup, pushGroup allow you to merge windows or groups inheriting the+-- position of the current window (pull) or the other window (push).+pullGroup :: Direction -> Navigate+pullGroup = mergeNav (\o c -> sendMessage $ Merge o c)+++pullWindow :: Direction -> Navigate+pullWindow = mergeNav (\o c -> sendMessage (UnMerge o) >> sendMessage (Merge o c))++pushGroup :: Direction -> Navigate+pushGroup = mergeNav (\o c -> sendMessage $ Merge c o)++pushWindow :: Direction -> Navigate+pushWindow = mergeNav (\o c -> sendMessage (UnMerge c) >> sendMessage (Merge c o))++mergeNav :: (Window -> Window -> X ()) -> Direction -> Navigate+mergeNav f = Apply (\o -> withFocused (f o))++-- | Apply a function on the stack belonging to the currently focused group. It+-- works for rearranging windows and for changing focus.+onGroup :: (W.Stack Window -> W.Stack Window) -> X ()+onGroup f = withFocused (sendMessage . WithGroup (return . f))++-- | Send a message to the currently focused sublayout.+toSubl :: (Message a) => a -> X ()+toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m))++instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where+    modifyLayout (Sublayout { subls = osls }) (W.Workspace i la st) r = do+            let gs' = updateGroup st $ toGroups osls+                st' = W.filter (`elem` M.keys gs') =<< st+            updateWs gs'+            runLayout (W.Workspace i la st') r++    redoLayout (Sublayout { delayMess = I ms, def = defl, subls = osls }) _r st arrs = do+        let gs' = updateGroup st $ toGroups osls+        sls <- fromGroups defl st gs' osls++        let newL :: LayoutClass l Window => Rectangle -> WorkspaceId -> (l Window,Bool)+                    -> (Maybe (W.Stack Window)) -> X ([(Window, Rectangle)], l Window)+            newL rect n (ol, mess) sst = do+                let handle l (y,_)+                        | mess = fromMaybe l <$> handleMessage l y+                        | otherwise = return l+                    kms = filter ((`elem` M.keys gs') . snd) ms+                nl <- foldM handle ol $ filter ((`elem` W.integrate' sst) . snd) kms+                fmap (fromMaybe nl) <$> runLayout (W.Workspace n nl sst) rect++            (urls,ssts) = unzip [ (newL gr i l sst, sst)+                    | l <- map (second $ const True) sls+                    | i <- map show [ 0 :: Int .. ]+                    | (k,gr) <- arrs, let sst = M.lookup k gs' ]++        arrs' <- sequence urls+        sls' <- return . Sublayout (I []) defl <$> fromGroups defl st gs'+                        [ (l,s) | (_,l) <- arrs' | (Just s) <- ssts ]+        return (concatMap fst arrs', sls')++    handleMess (Sublayout (I ms) defl sls) m+        | Just (SubMessage sm w) <- fromMessage m =+            return $ Just $ Sublayout (I ((sm,w):ms)) defl sls++        | Just (Broadcast sm) <- fromMessage m = do+            ms' <- fmap (zip (repeat sm) . W.integrate') currentStack+            return $ if null ms' then Nothing+                else Just $ Sublayout (I $ ms' ++ ms) defl sls++        | Just B.UpdateBoring <- fromMessage m = do+            let bs = concatMap unfocused $ M.elems gs+            ws <- gets (W.workspace . W.current . windowset)+            flip sendMessageWithNoRefresh ws $ B.Replace "Sublayouts" bs+            return Nothing++        | Just (WithGroup f w) <- fromMessage m+        , Just g <- M.lookup w gs = do+            g' <- f g+            let gs' = M.insert (W.focus g') g' $ M.delete (W.focus g) gs+            when (gs' /= gs) $ updateWs gs'+            when (w /= W.focus g') $ windows (W.focusWindow $ W.focus g')+            return Nothing++        | Just (MergeAll w) <- fromMessage m =+            let gs' = fmap (M.singleton w)+                    $ (focusWindow' w =<<) $ W.differentiate+                    $ concatMap W.integrate $ M.elems gs+            in maybe (return Nothing) fgs gs'++        | Just (UnMergeAll w) <- fromMessage m =+            let ws = concatMap W.integrate $ M.elems gs+                _ = w :: Window+                mkSingleton f = M.singleton f (W.Stack f [] [])+            in fgs $ M.unions $ map mkSingleton ws++        | Just (Merge x y) <- fromMessage m+        , let findGrp z = mplus (M.lookup z gs) $ listToMaybe+                $ M.elems $ M.filter ((z `elem`) . W.integrate) gs+        , Just (W.Stack _ xb xn) <- findGrp x+        , Just yst <- findGrp y =+            let zs = W.Stack x xb (xn ++ W.integrate yst)+            in fgs $ M.update (\_ -> Just zs) x $ M.delete y gs++        | Just (UnMerge x) <- fromMessage m =+            fgs . M.fromList . map (W.focus &&& id) . M.elems+                    $ M.mapMaybe (W.filter (x/=)) gs++        | otherwise = fmap join $ sequenceA $ catchLayoutMess <$> fromMessage m+     where gs = toGroups sls+           fgs gs' = do+                st <- currentStack+                Just . Sublayout (I ms) defl <$> fromGroups defl st gs' sls++           -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))+           --  This l must be the same as from the instance head,+           --  -XScopedTypeVariables should bring it into scope, but we are+           --  trying to avoid warnings with ghc-6.8.2 and avoid CPP+           catchLayoutMess x = do+            let m' = x `asTypeOf` (undefined :: LayoutMessages)+            ms' <- zip (repeat $ SomeMessage m') . W.integrate'+                    <$> currentStack+            return $ do guard $ not $ null ms'+                        Just $ Sublayout (I $ ms' ++ ms) defl sls++currentStack :: X (Maybe (W.Stack Window))+currentStack = gets (W.stack . W.workspace . W.current . windowset)++-- | update Group to follow changes in the workspace+updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a+updateGroup mst gs =+        let flatten = concatMap W.integrate . M.elems+            news = W.integrate' mst \\ flatten gs+            deads = flatten gs \\ W.integrate' mst++            uniNew = M.union (M.fromList $ map (\n -> (n,single n)) news)+            single x = W.Stack x [] []++            -- pass through a list to update/remove keys+            remDead = M.fromList . map (\w -> (W.focus w,w))+                        . mapMaybe (W.filter (`notElem` deads)) . M.elems++            -- update the current tab group's order and focus+            followFocus hs = fromMaybe hs $ do+                f' <- W.focus `fmap` mst+                xs <- find (elem f' . W.integrate) $ M.elems hs+                xs' <- W.filter (`elem` W.integrate xs) =<< mst+                return $ M.insert f' xs' $ M.delete (W.focus xs) hs++        in remDead $ uniNew $ followFocus gs++-- | rearrange the windowset to put the groups of tabs next to eachother, so+-- that the stack of tabs stays put.+updateWs :: Groups Window -> X ()+updateWs = windowsMaybe . updateWs'++updateWs' :: Groups Window -> WindowSet -> Maybe WindowSet+updateWs' gs ws = do+    f <- W.peek ws+    let w = W.index ws+        nes = concatMap W.integrate $ mapMaybe (flip M.lookup gs) w+        ws' = W.focusWindow f $ foldr W.insertUp (foldr W.delete' ws nes) nes+    guard $ W.index ws' /= W.index ws+    return ws'++-- | focusWindow'. focus an element of a stack, is Nothing if that element is+-- absent. See also 'W.focusWindow'+focusWindow' :: (Eq a) => a -> W.Stack a -> Maybe (W.Stack a)+focusWindow' w st = do+    guard $ not $ null $ filter (w==) $ W.integrate st+    if W.focus st == w then Just st+        else focusWindow' w $ W.focusDown' st++-- update only when Just+windowsMaybe :: (WindowSet -> Maybe WindowSet) -> X ()+windowsMaybe f = do+    xst <- get+    ws <- gets windowset+    let up fws = put xst { windowset = fws }+    maybe (return ()) up $ f ws++unfocused :: W.Stack a -> [a]+unfocused x = W.up x ++ W.down x++toGroups :: (Ord a) => [(a1, W.Stack a)] -> Map a (W.Stack a)+toGroups ws = M.fromList . map (W.focus &&& id) . nubBy (on (==) W.focus)+                    $ map snd ws++-- | restore the default layout for each group. It needs the X monad to switch+-- the default layout to a specific one (handleMessage NextLayout)+fromGroups :: (LayoutClass layout a, Ord k) =>+              ([Int], layout a)+              -> Maybe (W.Stack k)+              -> Groups k+              -> [(layout a, b)]+              -> X [(layout a, W.Stack k)]+fromGroups (skips,defl) st gs sls = do+    defls <- mapM (iterateM nextL defl !!) skips+    return $ fromGroups' defl defls st gs (map fst sls)+        where nextL l = fromMaybe l <$> handleMessage l (SomeMessage NextLayout)+              iterateM f = iterate (>>= f) . return++fromGroups' :: (Ord k) => a -> [a] -> Maybe (W.Stack k) -> Groups k -> [a]+                    -> [(a, W.Stack k)]+fromGroups' defl defls st gs sls =+    [ fromMaybe2 (dl, single w) (l, M.lookup w gs)+        | l <- map Just sls ++ repeat Nothing+        | dl <- defls ++ repeat defl+        | w <- W.integrate' $ W.filter (`notElem` unfocs) =<< st ]+    where unfocs = unfocused =<< M.elems gs+          single w = W.Stack w [] []+          fromMaybe2 (a,b) (x,y) = (fromMaybe a x, fromMaybe b y)
+ XMonad/Layout/TabBarDecoration.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TabBarDecoration+-- Copyright   :  (c) 2007 Andrea Rossato+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A layout modifier to add a bar of tabs to your layouts.+-----------------------------------------------------------------------------++module XMonad.Layout.TabBarDecoration+    ( -- * Usage+      -- $usage+      simpleTabBar, tabBar+    , defaultTheme, shrinkText+    , TabBarDecoration (..), XPPosition (..)+    , module XMonad.Layout.ResizeScreen+    ) where++import Data.List+import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.Decoration+import XMonad.Layout.ResizeScreen+import XMonad.Prompt ( XPPosition (..) )++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.TabBarDecoration+--+-- Then edit your @layoutHook@ by adding the layout you want:+--+-- > main = xmonad defaultConfig { layoutHook = simpleTabBar $ layoutHook defaultConfig}+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- 'tabBar' will give you the possibility of setting a custom shrinker+-- and a custom theme.+--+-- The deafult theme can be dynamically change with the xmonad theme+-- selector. See "XMonad.Prompt.Theme". For more themse, look at+-- "XMonad.Util.Themes"++-- | Add, on the top of the screen, a simple bar of tabs to a given+-- | layout, with the default theme and the default shrinker.+simpleTabBar :: Eq a => l a -> ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)+                (ModifiedLayout ResizeScreen l) a+simpleTabBar = decoration shrinkText defaultTheme (TabBar Top) . resizeVertical 20++-- | Same of 'simpleTabBar', but with the possibility of setting a+-- custom shrinker, a custom theme and the position: 'Top' or+-- 'Bottom'.+tabBar :: (Eq a, Shrinker s) => s -> Theme -> XPPosition -> l a -> ModifiedLayout (Decoration TabBarDecoration s) l a+tabBar s t p = decoration s t (TabBar p)++data TabBarDecoration a = TabBar XPPosition deriving (Read, Show)++instance Eq a => DecorationStyle TabBarDecoration a where+    describeDeco  _ = "TabBar"+    shrink    _ _ r = r+    pureDecoration (TabBar p) _ dht (Rectangle x y wh ht) s _ (w,_) =+        if isInStack s w then Just $ Rectangle nx ny wid (fi dht) else Nothing+        where wrs = S.integrate s+              loc i = (wh * fi i) `div` max 1 (fi $ length wrs)+              wid = maybe (fi x) (\i -> loc (i+1) - loc i) $ w `elemIndex` wrs+              ny  = case p of+                     Top    -> y+                     Bottom -> y + fi ht - fi dht+              nx  = (x +) $ maybe 0 (fi . loc) $ w `elemIndex` wrs
+ XMonad/Layout/Tabbed.hs view
@@ -0,0 +1,170 @@+{-# 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+      simpleTabbed, tabbed, addTabs+    , simpleTabbedAlways, tabbedAlways, addTabsAlways+    , simpleTabbedBottom, tabbedBottom, addTabsBottom+    , simpleTabbedBottomAlways, tabbedBottomAlways, addTabsBottomAlways+    , Theme (..)+    , defaultTheme+    , TabbedDecoration (..)+    , shrinkText, CustomShrink(CustomShrink)+    , Shrinker(..)+    ) where++import Data.Maybe+import Data.List++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.Decoration+import XMonad.Layout.Simplest ( Simplest(Simplest) )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.Tabbed+--+-- Then edit your @layoutHook@ by adding the Tabbed layout:+--+-- > myLayouts = simpleTabbed ||| Full ||| etc..+--+-- or, if you want a specific theme for you tabbed layout:+--+-- > myLayouts = tabbed shrinkText defaultTheme ||| Full ||| etc..+--+-- and then:+--+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- The default Tabbar behaviour is to hide it when only one window is open+-- on the workspace.  To have it always shown, use one of the layouts or+-- modifiers ending in "Always".+--+-- 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 = defaultTheme { inactiveBorderColor = "#FF0000"+-- >                                   , activeTextColor = "#00FF00"}+--+-- and+--+-- > mylayout = tabbed shrinkText myTabConfig ||| Full ||| etc..++-- Layouts++-- | A tabbed layout with the default xmonad Theme.+--+-- This is a minimal working configuration:+--+-- > import XMonad+-- > import XMonad.Layout.DecorationMadness+-- > main = xmonad defaultConfig { layoutHook = simpleTabbed }+simpleTabbed :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window+simpleTabbed = tabbed shrinkText defaultTheme++simpleTabbedAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window+simpleTabbedAlways = tabbedAlways shrinkText defaultTheme++-- | A bottom-tabbed layout with the default xmonad Theme.+simpleTabbedBottom :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window+simpleTabbedBottom = tabbedBottom shrinkText defaultTheme++-- | A bottom-tabbed layout with the default xmonad Theme.+simpleTabbedBottomAlways :: ModifiedLayout (Decoration TabbedDecoration DefaultShrinker) Simplest Window+simpleTabbedBottomAlways = tabbedBottomAlways shrinkText defaultTheme++-- | A layout decorated with tabs and the possibility to set a custom+-- shrinker and theme.+tabbed     :: (Eq a, Shrinker s) => s -> Theme +           -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a+tabbed s c = addTabs s c Simplest++tabbedAlways     :: (Eq a, Shrinker s) => s -> Theme +                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a+tabbedAlways s c = addTabsAlways s c Simplest++-- | A layout decorated with tabs at the bottom and the possibility to set a custom+-- shrinker and theme.+tabbedBottom     :: (Eq a, Shrinker s) => s -> Theme +                 -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a+tabbedBottom s c = addTabsBottom s c Simplest++tabbedBottomAlways     :: (Eq a, Shrinker s) => s -> Theme +                       -> ModifiedLayout (Decoration TabbedDecoration s) Simplest a+tabbedBottomAlways s c = addTabsBottomAlways s c Simplest++-- Layout Modifiers++-- | A layout modifier that uses the provided shrinker and theme to add tabs to any layout.+addTabs :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a+        -> ModifiedLayout (Decoration TabbedDecoration s) l a+addTabs = createTabs WhenPlural Top++addTabsAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a+              -> ModifiedLayout (Decoration TabbedDecoration s) l a+addTabsAlways = createTabs Always Top++-- | A layout modifier that uses the provided shrinker and theme to add tabs to the bottom of any layout.+addTabsBottom :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a+              -> ModifiedLayout (Decoration TabbedDecoration s) l a+addTabsBottom = createTabs WhenPlural Bottom++addTabsBottomAlways :: (Eq a, LayoutClass l a, Shrinker s) => s -> Theme -> l a+                    -> ModifiedLayout (Decoration TabbedDecoration s) l a+addTabsBottomAlways = createTabs Always Bottom+++-- Tab creation abstractions.  Internal use only.++-- Create tabbar when required at the given location with the given+-- shrinker and theme to the supplied layout.+createTabs                ::(Eq a, LayoutClass l a, Shrinker s) => TabbarShown -> TabbarLocation -> s+                          -> Theme -> l a -> ModifiedLayout (Decoration TabbedDecoration s) l a+createTabs sh loc tx th l = decoration tx th (Tabbed loc sh) l++data TabbarLocation = Top | Bottom deriving (Read,Show)++data TabbarShown = Always | WhenPlural deriving (Read, Show, Eq)++data TabbedDecoration a = Tabbed TabbarLocation TabbarShown deriving (Read, Show)++instance Eq a => DecorationStyle TabbedDecoration a where+    describeDeco (Tabbed Top _ ) = "Tabbed"+    describeDeco (Tabbed Bottom _ ) = "Tabbed Bottom"+    pureDecoration (Tabbed lc sh) _ ht _ s wrs (w,r@(Rectangle x y wh hh)) +        = if ((sh == Always && numWindows > 0) || numWindows > 1)+          then Just $ case lc of+                        Top -> upperTab+                        Bottom -> lowerTab+          else Nothing+        where ws = filter (`elem` map fst (filter ((==r) . snd) wrs)) (S.integrate s)+              loc i = x + fi ((wh * fi i) `div` max 1 (fi $ length ws))+              wid = fi $ maybe x (\i -> loc (i+1) - loc i) $ w `elemIndex` ws+              nx  = maybe x loc $ w `elemIndex` ws+              upperTab = Rectangle nx y wid (fi ht)+              lowerTab = Rectangle nx (y+fi(hh-ht)) wid (fi ht)+              numWindows = length ws+    shrink (Tabbed loc _ ) (Rectangle _ _ _ dh) (Rectangle x y w h) +        = case loc of+            Top -> Rectangle x (y + fi dh) w (h - dh)+            Bottom -> Rectangle x y w (h - dh)
+ XMonad/Layout/ThreeColumns.hs view
@@ -0,0 +1,103 @@+{-# 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. With 2560x1600 pixels this+-- layout can be used for a huge main window and up to six reasonable sized+-- slave windows.+--+-- Screenshot: <http://server.c-otto.de/xmonad/ThreeColumnsMiddle.png>+--+-----------------------------------------------------------------------------++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) ||| ThreeColMid 1 (3/100) (1/2) ||| etc..+-- > main = xmonad defaultConfig { layoutHook = myLayouts }+--+-- The first argument specifies hom many windows initially appear in the main+-- window. The second argument argument specifies the amount to resize while+-- resizing and the third argument specifies the initial size of the columns.+-- A positive size designates the fraction of the screen that the main window+-- should occupy, but if the size is negative the absolute value designates the+-- fraction a slave column should occupy. If both slave columns are visible,+-- they always occupy the same amount of space.+--+-- The ThreeColMid variant places the main window between the slave columns.+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"++-- | Arguments are nmaster, delta, fraction+data ThreeCol a = ThreeColMid { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational}+                | ThreeCol    { threeColNMaster :: !Int, threeColDelta :: !Rational, threeColFrac :: !Rational}+    deriving (Show,Read)++instance LayoutClass ThreeCol a where+    pureLayout (ThreeCol n _ f) r    = doL False n f r+    pureLayout (ThreeColMid n _ f) r = doL True n f r+    handleMessage l m =+        return $ msum [fmap resize     (fromMessage m)+                      ,fmap incmastern (fromMessage m)]+            where resize Shrink = l { threeColFrac = max (-0.5) $ f-d }+                  resize Expand = l { threeColFrac = min 1 $ f+d }+                  incmastern (IncMasterN x) = l { threeColNMaster = max 0 (n+x) }+                  n = threeColNMaster l+                  d = threeColDelta l+                  f = threeColFrac l+    description _ = "ThreeCol"++doL :: Bool-> Int-> Rational-> Rectangle-> W.Stack a-> [(a, Rectangle)]+doL m n f r = ap zip (tile3 m f r n . length) . W.integrate++-- | tile3.  Compute window positions using 3 panes+tile3 :: Bool -> Rational -> Rectangle -> Int -> Int -> [Rectangle]+tile3 middle 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 nslave1 r2 ++ splitVertically nslave2 r3+        where (r1, r2, r3) = split3HorizontallyBy middle (if f<0 then 1+2*f else f) r+              (s1, s2) = splitHorizontallyBy (if f<0 then 1+f else f) r+              nslave = (n - nmaster)+              nslave1 = ceiling (nslave % 2)+              nslave2 = (n - nmaster - nslave1)++split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)+split3HorizontallyBy middle f (Rectangle sx sy sw sh) =+    if middle+    then ( Rectangle (sx + fromIntegral r2w) sy r1w sh+         , Rectangle sx sy r2w sh+         , Rectangle (sx + fromIntegral r2w + fromIntegral r1w) sy r3w sh )+    else ( Rectangle sx sy r1w sh+         , Rectangle (sx + fromIntegral r1w) sy r2w sh+         , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh )+        where r1w = ceiling $ fromIntegral sw * f+              r2w = ceiling ( (sw - r1w) % 2 )+              r3w = sw - r1w - r2w
+ XMonad/Layout/ThreeColumnsMiddle.hs view
@@ -0,0 +1,4 @@+module XMonad.Layout.ThreeColumnsMiddle {-# DEPRECATED "Import XMonad.Layout.ThreeColumns instead" #-}+    (module XMonad.Layout.ThreeColumns) where++import XMonad.Layout.ThreeColumns (ThreeCol(ThreeColMid))
+ XMonad/Layout/ToggleLayouts.hs view
@@ -0,0 +1,97 @@+{-# 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   : none+-- Stability    : unstable+-- Portability  : portable+--+-- A module to toggle between two layouts.+-----------------------------------------------------------------------------++module XMonad.Layout.ToggleLayouts (+    -- * Usage+    -- $usage+    toggleLayouts, ToggleLayout(..)+    ) where++import XMonad+import XMonad.StackSet (Workspace (..))++-- $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+    runLayout (Workspace i (ToggleLayouts True lt lf) ms) r = do (ws,mlt') <- runLayout (Workspace i lt ms) r+                                                                 return (ws,fmap (\lt' -> ToggleLayouts True lt' lf) mlt')++    runLayout (Workspace i (ToggleLayouts False lt lf) ms) r = do (ws,mlf') <- runLayout (Workspace i lf ms) r+                                                                  return (ws,fmap (\lf' -> ToggleLayouts False lt lf') mlf')+    description (ToggleLayouts True lt _) = description lt+    description (ToggleLayouts False _ lf) = description lf+    handleMessage (ToggleLayouts bool lt lf) m+        | 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,62 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.TwoPane+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License     :  BSD3-style (see LICENSE)+-- +-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- 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++    description _ = "TwoPane"
+ XMonad/Layout/WindowArranger.hs view
@@ -0,0 +1,224 @@+{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable+{-# LANGUAGE PatternGuards           #-}+{-# LANGUAGE FlexibleInstances       #-}+{-# LANGUAGE MultiParamTypeClasses   #-}+{-# LANGUAGE TypeSynonymInstances    #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.WindowArranger+-- Copyright   :  (c) Andrea Rossato 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- This is a pure layout modifier that will let you move and resize+-- windows with the keyboard in any layout.+-----------------------------------------------------------------------------++module XMonad.Layout.WindowArranger+    ( -- * Usage+      -- $usage+      windowArrange+    , windowArrangeAll+    , WindowArrangerMsg (..)+    , WindowArranger+    , memberFromList+    , listFromList+    , diff+    ) where++import XMonad+import qualified XMonad.StackSet as S+import XMonad.Layout.LayoutModifier+import XMonad.Util.XUtils (fi)++import Control.Arrow+import Data.List+import Data.Maybe++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Layout.WindowArranger+-- > myLayout = layoutHook defaultConfig+-- > main = xmonad defaultConfig { layoutHook = windowArrange myLayout }+--+-- or+--+-- > main = xmonad defaultConfig { layoutHook = windowArrangeAll myLayout }+--+-- For more detailed instructions on editing the layoutHook see:+--+-- "XMonad.Doc.Extending#Editing_the_layout_hook"+--+-- You may also want to define some key binding to move or resize+-- windows. These are good defaults:+--+-- >        , ((modMask x .|. controlMask              , xK_s    ), sendMessage  Arrange         )+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_s    ), sendMessage  DeArrange       )+-- >        , ((modMask x .|. controlMask              , xK_Left ), sendMessage (MoveLeft      1))+-- >        , ((modMask x .|. controlMask              , xK_Right), sendMessage (MoveRight     1))+-- >        , ((modMask x .|. controlMask              , xK_Down ), sendMessage (MoveDown      1))+-- >        , ((modMask x .|. controlMask              , xK_Up   ), sendMessage (MoveUp        1))+-- >        , ((modMask x                 .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft  1))+-- >        , ((modMask x                 .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1))+-- >        , ((modMask x                 .|. shiftMask, xK_Down ), sendMessage (IncreaseDown  1))+-- >        , ((modMask x                 .|. shiftMask, xK_Up   ), sendMessage (IncreaseUp    1))+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft  1))+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1))+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown  1))+-- >        , ((modMask x .|. controlMask .|. shiftMask, xK_Up   ), sendMessage (DecreaseUp    1))+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- | A layout modifier to float the windows in a workspace+windowArrange :: l a -> ModifiedLayout WindowArranger l a+windowArrange = ModifiedLayout (WA True False Nothing [])++-- | A layout modifier to float all the windows in a workspace+windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a+windowArrangeAll = ModifiedLayout (WA True True Nothing [])++data WindowArrangerMsg = DeArrange+                       | Arrange+                       | IncreaseLeft  Int+                       | IncreaseRight Int+                       | IncreaseUp    Int+                       | IncreaseDown  Int+                       | DecreaseLeft  Int+                       | DecreaseRight Int+                       | DecreaseUp    Int+                       | DecreaseDown  Int+                       | MoveLeft      Int+                       | MoveRight     Int+                       | MoveUp        Int+                       | MoveDown      Int+                       | SetGeometry   Rectangle+                         deriving ( Typeable )+instance Message WindowArrangerMsg++data ArrangedWindow a = WR   (a, Rectangle)+                      | AWR  (a, Rectangle)+                        deriving (Read, Show)++type ArrangeAll = Bool+data WindowArranger a = WA Bool ArrangeAll (Maybe Rectangle) [ArrangedWindow a] deriving (Read, Show)++instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where+    pureModifier (WA True b _   []) sr (Just _)               wrs = arrangeWindows b sr wrs++    pureModifier (WA True b maybeSr awrs) sr (Just (S.Stack w _ _)) wrs = curry process wrs awrs'+        where+          (maybeSr', awrs') = adjustForNewScreenRectangle sr maybeSr awrs+          wins         = map fst       *** map awrWin+          update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)+          process      = wins &&&  id  >>> first diff   >>> uncurry update >>>+                         replaceWR wrs >>> putOnTop w   >>> map fromAWR &&& Just . WA True b maybeSr'++    pureModifier _ _ _ wrs = (wrs, Nothing)++    pureMess (WA True b maybeSr (wr:wrs)) m+        -- increase the window's size+        | Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y        (w + fi i) h+        | Just (IncreaseLeft  i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y        (w + fi i) h+        | Just (IncreaseUp    i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y - fi i) w        (h + fi i)+        | Just (IncreaseDown  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y         w        (h + fi i)+        -- decrease the window's size+        | Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y        (chk  w i) h+        | Just (DecreaseLeft  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y        (chk  w i) h+        | Just (DecreaseUp    i) <- fm, (win, Rectangle x y w h) <- fa = res win  x         y         w        (chk h i)+        | Just (DecreaseDown  i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y + fi i) w        (chk h i)+        --move the window around+        | Just (MoveRight     i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y         w         h+        | Just (MoveLeft      i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y         w         h+        | Just (MoveUp        i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y - fi i) w         h+        | Just (MoveDown      i) <- fm, (win, Rectangle x y w h) <- fa = res win  x        (y + fi i) w         h++        where res wi x y w h = Just . WA True b maybeSr $ AWR (wi,Rectangle x y w h):wrs+              fm             = fromMessage m+              fa             = fromAWR     wr+              chk        x y = fi $ max 1 (fi x - y)++    pureMess (WA t b maybeSr (wr:wrs)) m+        | Just (SetGeometry   r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b maybeSr $ AWR (w,r):wrs++    pureMess (WA _ b maybeSr l) m+        | Just DeArrange <- fromMessage m = Just $ WA False b maybeSr l+        | Just Arrange   <- fromMessage m = Just $ WA True  b maybeSr l+        | otherwise                       = Nothing++adjustForNewScreenRectangle :: Rectangle -> (Maybe Rectangle) -> [ArrangedWindow a] -> (Maybe Rectangle, [ArrangedWindow a])+adjustForNewScreenRectangle sr Nothing awrs = (Just sr, awrs)+adjustForNewScreenRectangle sr@(Rectangle x y _ _) (Just oldSr@(Rectangle oldX oldY _ _)) awrs+    | (sr == oldSr)     = (Just sr, awrs)+    | otherwise         = (Just sr, map (adjustRectangle offsetX offsetY) awrs)+    where+        offsetX = x - oldX+        offsetY = y - oldY++adjustRectangle :: Position -> Position -> ArrangedWindow a -> ArrangedWindow a+adjustRectangle _ _ (WR x) = (WR x)+adjustRectangle offsetX offsetY (AWR (win, Rectangle x y w h)) =+                             (AWR (win, Rectangle (x + offsetX) (y + offsetY) w h))++arrangeWindows :: ArrangeAll -> Rectangle -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))+arrangeWindows b sr wrs = (wrs, Just $ WA True b (Just sr) (map t wrs))+    where t = if b then AWR else WR++fromAWR :: ArrangedWindow a -> (a, Rectangle)+fromAWR (WR   x) = x+fromAWR (AWR  x) = x++awrWin :: ArrangedWindow a -> a+awrWin = fst . fromAWR++getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]+getAWR = memberFromList awrWin (==)++getWR ::  Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)]+getWR = memberFromList fst (==)++mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]+mkNewAWRs b w wrs = map t . concatMap (flip getWR wrs) $ w+    where t = if b then AWR else WR++removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]+removeAWRs = listFromList awrWin notElem++putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]+putOnTop w awrs = awr ++ nawrs+    where awr   = getAWR w awrs+          nawrs = filter ((/=w) . awrWin) awrs++replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]+replaceWR wrs = foldr r []+    where r x xs+              | WR wr <- x = case fst wr `elemIndex` map fst wrs of+                               Just i  -> (WR $ wrs !! i):xs+                               Nothing -> x:xs+              | otherwise  = x:xs++-- | Given a function to be applied to each member of a list, and a+-- function to check a condition by processing this transformed member+-- with the members of a list, you get the list of members that+-- satisfy the condition.+listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]+listFromList f g l = foldr (h l) []+    where h x y ys = if g (f y) x then y:ys else ys++-- | Given a function to be applied to each member of ta list, and a+-- function to check a condition by processing this transformed member+-- with something, you get the first member that satisfy the condition,+-- or an empty list.+memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]+memberFromList f g l = foldr (h l) []+    where h x y ys = if g (f y) x then [y] else ys++-- | Get the list of elements to be deleted and the list ef elements to+-- be added to the first list in order to get the second list.+diff :: Eq a => ([a],[a]) -> ([a],[a])+diff (x,y) = (x \\ y, y \\ x)
+ XMonad/Layout/WindowNavigation.hs view
@@ -0,0 +1,231 @@+{-# 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  :  Devin Mullins <me@twifkak.com>+-- 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++import XMonad.Hooks.ManageDocks (Direction(..))++-- $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+              | Apply (Window -> X()) Direction -- ^ Apply action with destination window+        deriving ( Typeable )+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.4) "#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 (Just s) origwrs =+        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) origwrs of ((_,x):_) -> x+                                                         []        -> rscr+               pt   = case state of Just (NS ptold _) | ptold `inrect` r -> ptold+                                    _ -> center r+               existing_wins = W.integrate s+               wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $+                     filter ((/=w) . fst) origwrs+               wnavigable = nub $ concatMap+                            (\d -> truncHead $ navigable d pt wrs) [U,D,R,L]+               wnavigablec = nub $ concatMap+                            (\d -> map (\(win,_) -> (win,dirc d)) $+                                   truncHead $ navigable d pt 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 (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)+    redoLayout _ _ _ origwrs = return (origwrs, Nothing)++    handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m+        | Just (Go d) <- fromMessage m =+                         case navigable d pt 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 navigable d pt 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 navigable d pt 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 (Apply f d) <- fromMessage m =+             case navigable d pt wrs of+             []         -> return Nothing+             ((w,_):_)  -> f w >> return Nothing+        | 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++navigable :: Direction -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]+navigable d pt = sortby d . filter (inr d pt . snd)++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/WindowSwitcherDecoration.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.WindowSwitcherDecoration+-- Copyright   :  (c) Jan Vornberger 2009+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de+-- Stability   :  unstable+-- Portability :  not portable+--+-----------------------------------------------------------------------------++module XMonad.Layout.WindowSwitcherDecoration+    ( windowSwitcherDecoration+    ) where++import XMonad+import XMonad.Layout.Decoration+import XMonad.Layout.DraggingVisualizer+import qualified XMonad.StackSet as S+import Control.Monad+import Foreign.C.Types(CInt)++windowSwitcherDecoration :: (Eq a, Shrinker s) => s -> Theme+           -> l a -> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a+windowSwitcherDecoration s c = decoration s c $ WindowSwitcherDecoration++data WindowSwitcherDecoration a = WindowSwitcherDecoration deriving (Show, Read)++instance Eq a => DecorationStyle WindowSwitcherDecoration a where+    describeDeco _ = "WindowSwitcherDeco"++    decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleTiledDraggingInProgress ex ey (mainw, r) x y+    decorationAfterDraggingHookAddon _ (mainw, _) hasCrossed = unless hasCrossed $ do+                                                                 sendMessage $ DraggingStopped+                                                                 performWindowSwitching mainw++handleTiledDraggingInProgress :: CInt -> CInt -> (Window, Rectangle) -> Position -> Position -> X ()+handleTiledDraggingInProgress ex ey (mainw, r) x y = do+    let rect = Rectangle (x - (fi ex - rect_x r))+                         (y - (fi ey - rect_y r))+                         (rect_width  r)+                         (rect_height r)+    sendMessage $ DraggingWindow mainw rect++performWindowSwitching :: Window -> X ()+performWindowSwitching win =+    withDisplay $ \d -> do+       root <- asks theRoot+       (_, _, selWin, _, _, _, _, _) <- io $ queryPointer d root+       ws <- gets windowset+       let allWindows = S.index ws+       -- do a little double check to be sure+       if (win `elem` allWindows) && (selWin `elem` allWindows)+            then do+                let allWindowsSwitched = map (switchEntries win selWin) allWindows+                let (ls, t:rs) = break (win ==) allWindowsSwitched+                let newStack = S.Stack t (reverse ls) rs+                windows $ S.modify' $ \_ -> newStack+            else return ()+    where+        switchEntries a b x+            | x == a    = b+            | x == b    = a+            | otherwise = x
+ XMonad/Layout/WorkspaceDir.hs view
@@ -0,0 +1,92 @@+{-# 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  :  none+-- 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 Control.Monad ( when )++import XMonad hiding ( focus )+import XMonad.Util.Run ( runProcessWithInput )+import XMonad.Prompt ( XPConfig )+import XMonad.Prompt.Directory ( directoryPrompt )+import XMonad.Layout.LayoutModifier+import XMonad.StackSet ( tag, currentTag )++-- $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 Window where+    modifyLayout (WorkspaceDir d) w r = do tc <- gets (currentTag.windowset)+                                           when (tc == tag w) $ scd d+                                           runLayout w r+    handleMess (WorkspaceDir _) m+        | Just (Chdir wd) <- fromMessage m = do wd' <- cleanDir wd+                                                return $ Just $ WorkspaceDir wd'+        | 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,835 @@+{-# LANGUAGE ExistentialQuantification #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for writing graphical prompts for XMonad+--+-----------------------------------------------------------------------------++module XMonad.Prompt+    ( -- * Usage+      -- $usage+      mkXPrompt+    , mkXPromptWithReturn+    , amberXPConfig+    , defaultXPConfig+    , greenXPConfig+    , XPType (..)+    , XPPosition (..)+    , XPConfig (..)+    , XPrompt (..)+    , ComplFunction+    -- * X Utilities+    -- $xutils+    , mkUnmanagedWindow+    , fillDrawable+    -- * Other Utilities+    -- $utils+    , mkComplFunFromList+    , mkComplFunFromList'+    -- * @nextCompletion@ implementations+    , getNextOfLastWord+    , getNextCompletion+    -- * List utilities+    , getLastWord+    , skipLastWord+    , splitInSubListsAt+    , breakAtSpace+    , uniqSort+    , decodeInput+    , encodeOutput+    , historyCompletion+    -- * History filters+    , deleteAllDuplicates+    , deleteConsecutive+    ) where++import Prelude hiding (catch)++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.Concurrent (threadDelay)+import Control.Monad.Reader+import Control.Monad.State+import Control.Applicative ((<$>))+import Data.Char+import Data.Bits ((.&.))+import Data.Maybe+import Data.List+import Data.Set (fromList, toList)+import System.Directory+import System.IO+import System.Posix.Files+import Control.Exception hiding (handle)++import qualified Data.Map as Map+import Data.Map (Map)++-- $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]+        , showComplWin       :: Bool+        , gcon               :: !GC+        , fontS              :: !XMonadFont+        , xptype             :: !XPType+        , commandHistory     :: W.Stack String+        , offset             :: !Int+        , config             :: XPConfig+        , successful         :: Bool+        }++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+        , historyFilter     :: [String] -> [String]+                                          -- ^ a filter to determine which+                                          -- history entries to remember+        , defaultText       :: String     -- ^ The text by default in the prompt line+        , autoComplete      :: Maybe Int  -- ^ Just x: if only one completion remains, auto-select it,+        , showCompletionOnTab :: Bool     -- ^ Only show list of completions when Tab was pressed+                                          --   and delay by x microseconds+        }++data XPType = forall p . XPrompt p => XPT p++instance Show XPType where+    show (XPT p) = showXPrompt p++instance XPrompt XPType where+    showXPrompt                 = show+    nextCompletion      (XPT t) = nextCompletion      t+    commandToComplete   (XPT t) = commandToComplete   t+    completionToCommand (XPT t) = completionToCommand t++-- | The class prompt types must be an instance of. In order to+-- create a prompt you need to create a data type, without parameters,+-- 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++    -- | This method is used to print the string to be+    -- displayed in the command line window.+    showXPrompt :: t -> String++    -- | This method is used to generate the next completion to be+    -- printed in the command line when tab is pressed, given the+    -- string presently in the command line and the list of+    -- completion.+    nextCompletion :: t -> String -> [String] -> String+    nextCompletion t c l = getNextOfLastWord t c l++    -- | This method is used to generate the string to be passed to+    -- the completion function.+    commandToComplete :: t -> String -> String+    commandToComplete _ c = getLastWord c++    -- | This method is used to process each completion in order to+    -- generate the string that will be compared with the command+    -- presently displayed in the command line. If the prompt is using+    -- 'getNextOfLastWord' for implementing 'nextCompletion' (the+    -- default implementation), this method is also used to generate,+    -- from the returned completion, the string that will form the+    -- next command line when tab is pressed.+    completionToCommand :: t -> String -> String+    completionToCommand _ c = c++data XPPosition = Top+                | Bottom+                  deriving (Show,Read)++amberXPConfig, defaultXPConfig, greenXPConfig :: XPConfig+defaultXPConfig =+    XPC { font              = "-misc-fixed-*-*-*-*-12-*-*-*-*-*-*-*"+        , bgColor           = "grey22"+        , fgColor           = "grey80"+        , fgHLight          = "black"+        , bgHLight          = "grey"+        , borderColor       = "white"+        , promptBorderWidth = 1+        , position          = Bottom+        , height            = 18+        , historySize       = 256+        , historyFilter     = id+        , defaultText       = []+        , autoComplete      = Nothing+        , showCompletionOnTab = False }+greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black" }+amberXPConfig = defaultXPConfig { fgColor = "#ca8f2d", bgColor = "black", fgHLight = "#eaaf4c" }++type ComplFunction = String -> IO [String]++initState :: XPrompt p => Display -> Window -> Window -> Rectangle -> ComplFunction+          -> GC -> XMonadFont -> p -> [String] -> XPConfig -> XPState+initState d rw w s compl gc fonts pt h c =+    XPS { dpy                = d+        , rootw              = rw+        , win                = w+        , screen             = s+        , complWin           = Nothing+        , complWinDim        = Nothing+        , completionFunction = compl+        , showComplWin       = not (showCompletionOnTab c)+        , gcon               = gc+        , fontS              = fonts+        , xptype             = XPT pt+        , commandHistory     = W.Stack { W.focus = defaultText c+                                       , W.up    = []+                                       , W.down  = h }+        , offset             = length (defaultText c)+        , config             = c+        , successful         = False+        }++-- this would be much easier with functional references+command :: XPState -> String+command = W.focus . commandHistory++setCommand :: String -> XPState -> XPState+setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }}++-- | 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+  hist <- liftIO $ readHistory+  w <- liftIO $ createWin d rw conf s+  liftIO $ selectInput d w $ exposureMask .|. keyPressMask+  gc <- liftIO $ createGC d w+  liftIO $ setGraphicsExposures d gc False+  fs <- initXMF (font conf)+  let hs = fromMaybe [] $ Map.lookup (showXPrompt t) hist+      st = initState d rw w s compl gc fs (XPT t) hs conf+  st' <- liftIO $ execStateT runXP st++  releaseXMF fs+  liftIO $ freeGC d gc+  if successful st'+    then do+      liftIO $ writeHistory $ Map.insertWith+                                (\xs ys -> take (historySize conf)+                                        . historyFilter conf $ xs ++ ys)+                                (showXPrompt t) [command st'] hist+      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+  if length c > 1 then modify $ \s -> s { showComplWin = True } else return ()+  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+  let updateState l = do let new_command = nextCompletion (xptype st) (command st) l+                         modify $ \s ->  setCommand new_command $ s { offset = length new_command }+      updateWins  l = do redrawWindows l+                         eventLoop (completionHandle l)+  case c of+    []  -> updateWindows   >> eventLoop handle+    [x] -> updateState [x] >> getCompletions >>= updateWins+    l   -> updateState l   >> updateWins l+-- key release+    | t == keyRelease && ks == xK_Tab = eventLoop (completionHandle c)+-- other keys+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++tryAutoComplete :: XP Bool+tryAutoComplete = do+    ac <- gets (autoComplete . config)+    case ac of+        Just d -> do cs <- getCompletions+                     case cs of+                         [c] -> runCompleted c d >> return True+                         _   -> return False+        Nothing    -> return False+  where runCompleted cmd delay = do+            st <- get+            let new_command = nextCompletion (xptype st) (command st) [cmd]+            modify $ setCommand "autocompleting..."+            updateWindows+            io $ threadDelay delay+            modify $ setCommand new_command+            return True++-- KeyPresses++data Direction = Prev | Next deriving (Eq,Show,Read)++keyPressHandle :: KeyMask -> KeyStroke -> XP ()+-- commands: ctrl + ... todo+keyPressHandle mask (ks,_)+    | (mask .&. controlMask) > 0 =+        -- 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_Right           -> moveWord Next >> go+            | ks == xK_Left            -> moveWord Prev >> go+            | ks == xK_Delete          -> killWord Next >> go+            | ks == xK_BackSpace       -> killWord Prev >> go+            | ks == xK_w               -> killWord Prev >> go+            | ks == xK_g || ks == xK_c -> quit+            | otherwise  -> eventLoop handle -- unhandled control sequence+    | ks == xK_Return || ks == xK_KP_Enter    = setSuccess True+    | 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_Home      = startOfLine       >> go+    | ks == xK_End       = endOfLine         >> go+    | ks == xK_Down      = moveHistory  W.focusUp' >> go+    | ks == xK_Up        = moveHistory  W.focusDown' >> go+    | ks == xK_Escape    = quit+    where+      go   = updateWindows >> eventLoop handle+      quit = flushString >> setSuccess False -- quit and discard everything+-- insert a character+keyPressHandle _ (_,s)+    | s == "" = eventLoop handle+    | otherwise = do insertString (decodeInput s)+                     updateWindows+                     completed <- tryAutoComplete+                     if completed then setSuccess True else eventLoop handle++setSuccess :: Bool -> XP ()+setSuccess b = modify $ \s -> s { successful = b }++-- KeyPress and State++-- | Kill the portion of the command before the cursor+killBefore :: XP ()+killBefore =+  modify $ \s -> setCommand (drop (offset s) (command s)) $ s { offset  = 0 }++-- | Kill the portion of the command including and after the cursor+killAfter :: XP ()+killAfter =+  modify $ \s -> setCommand (take (offset s) (command s)) s++-- | Kill the next\/previous word+killWord :: Direction -> XP ()+killWord d = do+  o <- gets offset+  c <- gets command+  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 -> setCommand ncom $ s { 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 -> setCommand "" $ s { offset = 0}++-- | Insert a character at the cursor position+insertString :: String -> XP ()+insertString str =+  modify $ \s -> setCommand (c (command s) (offset s)) $ 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 -> setCommand (c (command s) (offset s)) $ 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)++-- | move the cursor one word+moveWord :: Direction -> XP ()+moveWord d = do+  c <- gets command+  o <- gets offset+  let (f,ss) = splitAt o c+      lenToS = length . fst . break isSpace+      ln p s = case p s of+                 ' ':x -> 1 + lenToS x+                 x     -> lenToS x+      newoff = case d of+                 Prev -> o - (ln reverse f )+                 Next -> o + (ln id      ss)+  modify $ \s -> s { offset = newoff }++moveHistory :: (W.Stack String -> W.Stack String) -> XP ()+moveHistory f = modify $ \s -> let ch = f $ commandHistory s+                               in s { commandHistory = ch+                                    , offset         = length $ W.focus ch }++-- 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+  Just bgcolor <- io $ initColor d (bgColor c)+  Just border  <- io $ initColor d (borderColor c)+  p <- io $ createPixmap d w wh ht+                         (defaultDepthOfScreen scr)+  io $ fillDrawable d p gc border bgcolor (fi bw) wh ht+  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 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) (commandToComplete (xptype s) (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 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+  Just bgcolor <- io $ initColor d (bgColor c)+  Just 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 /= [] && showComplWin st)+     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 completionToCommand (xptype st) s == commandToComplete (xptype st) (command st)+     then printStringXMF d drw (fontS st) gc+                            (fgHLight $ config st) (bgHLight $ config st) x y s+     else printStringXMF d drw (fontS st) gc fc bc x y s++-- History++type History = Map String [String]++emptyHistory :: History+emptyHistory = Map.empty++getHistoryFile :: IO FilePath+getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad"++readHistory :: IO History+readHistory = catch readHist (const (return emptyHistory))+ where+    readHist = do+        path <- getHistoryFile+        xs <- bracket (openFile path ReadMode) hClose hGetLine+        readIO xs++writeHistory :: History -> IO ()+writeHistory hist = do+  path <- getHistoryFile+  catch (writeFile path (show hist)) $ const $ hPutStrLn stderr "error in writing"+  setFileMode path mode +    where mode = ownerReadMode .|. ownerWriteMode++-- $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++-- | This function takes a list of possible completions and returns a+-- completions function to be used with 'mkXPrompt'. If the string is+-- null it will return all completions.+mkComplFunFromList' :: [String] -> String -> IO [String]+mkComplFunFromList' l [] = return l+mkComplFunFromList' l s =+  return $ filter (\x -> take (length s) x == s) l+++-- | Given the prompt type, the command line and the completion list,+-- return the next completion in the list for the last word of the+-- command line. This is the default 'nextCompletion' implementation.+getNextOfLastWord :: XPrompt t => t -> String -> [String] -> String+getNextOfLastWord t c l = skipLastWord c ++ completionToCommand t (l !! ni)+    where ni = case commandToComplete t c `elemIndex` map (completionToCommand t) l of+                 Just i -> if i >= length l - 1 then 0 else i + 1+                 Nothing -> 0++-- | An alternative 'nextCompletion' implementation: given a command+-- and a completion list, get the next completion in the list matching+-- the whole command line.+getNextCompletion :: String -> [String] -> String+getNextCompletion c l = l !! idx+    where idx = case c `elemIndex` l of+                  Just i  -> if i >= length l - 1 then 0 else i + 1+                  Nothing -> 0++-- Lift an IO action into the XP+io :: IO a -> XP a+io = liftIO++-- 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++-- | 'historyCompletion' provides a canned completion function much like+--   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work+--   from the query history stored in ~\/.xmonad\/history.+historyCompletion :: ComplFunction+historyCompletion x = fmap (deleteConsecutive . filter (isInfixOf x) . Map.fold (++) []) readHistory++-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off+--   laziness and stability for efficiency.+uniqSort :: Ord a => [a] -> [a]+uniqSort = toList . fromList++-- | Functions to be used with the 'historyFilter' setting.+-- 'deleteAllDuplicates' will remove all duplicate entries.+-- 'deleteConsecutive' will only remove duplicate elements+-- immediately next to each other.+deleteAllDuplicates, deleteConsecutive :: [String] -> [String]+deleteAllDuplicates = nub+deleteConsecutive = map head . group
+ XMonad/Prompt/AppLauncher.hs view
@@ -0,0 +1,72 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.AppLauncher+-- Copyright   :  (C) 2008 Luis Cabellos+-- License     :  BSD3+--+-- Maintainer  :  zhen.sydow@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for launch applicationes that receive parameters in the command +-- line. The launcher call a prompt to get the parameters.+--+-----------------------------------------------------------------------------+module XMonad.Prompt.AppLauncher ( -- * Usage+                                    -- $usage+                                    launchApp+                                   ,module XMonad.Prompt+                                  -- * Use case: launching gimp with file+                                  -- $tip+                                  ) where++import XMonad (X(),MonadIO)+import XMonad.Core (spawn)+import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig())+import XMonad.Prompt.Shell (getShellCompl)++{- $usage+   This module is intended to allow the launch of the same application+   but changing the parameters using the user response. For example, when+   you want to open a image in gimp program, you can open gimp and then use+   the File Menu to open the image or you can use this module to select+   the image in the command line.+   +   We use Prompt to get the user command line. This also allow to autoexpand+   the names of the files when we are writing the command line.+ -}++{- $tip++First, you need to import necessary modules. Prompt is used to get the promp+configuration and the AppLauncher module itself.++> import XMonad.Prompt+> import XMonad.Prompt.AppLauncher as AL++Then you can add the bindings to the applications.++> ...+> , ((modm, xK_g), AL.launchApp defaultXPConfig "gimp" )+> , ((modm, xK_g), AL.launchApp defaultXPConfig "evince" )+> ...++ -}++-- A customized prompt+data AppPrompt = AppPrompt String+instance XPrompt AppPrompt where+    showXPrompt (AppPrompt n) = n ++ " "++type Application = String+type Parameters = String++{- | Given an application and its parameters, launch the application. -}+launch :: MonadIO m => Application -> Parameters -> m ()+launch app params = spawn ( app ++ " " ++ params )+++{- | Get the user's response to a prompt an launch an application using the+   input as command parameters of the application.-}+launchApp :: XPConfig -> Application -> X ()+launchApp config app = mkXPrompt (AppPrompt app) config (getShellCompl []) $ launch app
+ 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/DirExec.hs view
@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.DirExec+-- Copyright   :  (C) 2008 Juraj Hercek+-- License     :  BSD3+--+-- Maintainer  :  juhe_xmonad@hck.sk+-- Stability   :  unstable+-- Portability :  unportable+--+-- A directory file executables prompt for XMonad. This might be useful if you+-- don't want to have scripts in your PATH environment variable (same+-- executable names, different behavior) - otherwise you might want to use+-- "XMonad.Prompt.Shell" instead - but you want to have easy access to these+-- executables through the xmonad's prompt.+--+-----------------------------------------------------------------------------++module XMonad.Prompt.DirExec+    ( -- * Usage+      -- $usage+      dirExecPrompt+    , dirExecPromptNamed+    ) where++import System.Directory+import Control.Monad+import Data.List+import XMonad+import XMonad.Prompt++-- $usage+-- 1. In your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt.DirExec+--+-- 2. In your keybindings add something like:+--+-- >   , ("M-C-x", dirExecPrompt defaultXPConfig spawn "/home/joe/.scipts")+--+-- or+--+-- >   , ("M-C-x", dirExecPromptNamed defaultXPConfig spawn+-- >                                  "/home/joe/.scripts" "My Scripts: ")+--+-- or add this after your default bindings:+--+-- >   +++-- >   [ ("M-x " ++ key, dirExecPrompt defaultXPConfig fn "/home/joe/.scripts")+-- >     | (key, fn) <- [ ("x", spawn), ("M-x", runInTerm "-hold") ]+-- >   ]+-- >   +++--+-- The first alternative uses the last element of the directory path for+-- a name of prompt. The second alternative uses the provided string+-- for the name of the prompt. The third alternative defines 2 key bindings,+-- first one spawns the program by shell, second one runs the program in+-- terminal+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data DirExec = DirExec String++instance XPrompt DirExec where+    showXPrompt (DirExec name) = name++-- | Function 'dirExecPrompt' starts the prompt with list of all executable+-- files in directory specified by 'FilePath'. The name of the prompt is taken+-- from the last element of the path. If you specify root directory - @\/@ - as+-- the path, name @Root:@ will be used as the name of the prompt instead. The+-- 'XPConfig' parameter can be used to customize visuals of the prompt.+-- The runner parameter specifies the function used to run the program - see+-- usage for more information+dirExecPrompt :: XPConfig -> (String -> X ()) -> FilePath -> X ()+dirExecPrompt cfg runner path = do+    let name = (++ ": ") . last+                         . (["Root"] ++) -- handling of "/" path parameter+                         . words+                         . map (\x -> if x == '/' then ' ' else x)+                         $ path+    dirExecPromptNamed cfg runner path name++-- | Function 'dirExecPromptNamed' does the same as 'dirExecPrompt' except+-- the name of the prompt is specified by 'String' parameter.+dirExecPromptNamed :: XPConfig -> (String -> X ()) -> FilePath -> String -> X ()+dirExecPromptNamed cfg runner path name = do+    let path' = path ++ "/"+    cmds <- io $ getDirectoryExecutables path'+    mkXPrompt (DirExec name) cfg (compList cmds) (runner . (path' ++))+    where+        compList cmds s = return . filter (isInfixOf s) $ cmds++getDirectoryExecutables :: FilePath -> IO [String]+getDirectoryExecutables path =+    (getDirectoryContents path >>=+        filterM (\x -> let x' = path ++ x in+            liftM2 (&&)+                (doesFileExist x')+                (liftM executable (getPermissions x'))))+    `catch` (return . return . show)+
+ XMonad/Prompt/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,109 @@+-----------------------------------------------------------------------------+-- |+-- 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)+-----------------------------------------------------------------------------++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 = do+  mans <- io getMans+  mkXPrompt Man c (manCompl mans) $ runInTerm "" . (++) "man "++getMans :: IO [String]+getMans = do+  paths <- getCommandOutput "manpath -g 2>/dev/null" `E.catch` \_ -> return []+  let sects    = ["man" ++ show n | n <- [1..9 :: Int]]+      dirs     = [d ++ "/" ++ s | d <- split ':' paths, s <- sects]+  mans <- forM dirs $ \d -> do+            exists <- doesDirectoryExist d+            if exists+              then map (stripExt . stripSuffixes [".gz", ".bz2"]) `fmap`+                   getDirectoryContents d+              else return []+  return $ uniqSort $ concat mans++manCompl :: [String] -> String -> IO [String]+manCompl mans s | s == "" || last s == ' ' = return []+                | otherwise                = do+  -- XXX readline instead of bash's compgen?+  f <- lines `fmap` getCommandOutput ("bash -c 'compgen -A file " ++ s ++ "'")+  mkComplFunFromList (f ++ mans) s++-- | Run a command using shell and return its output.+--+-- XXX Merge into 'XMonad.Util.Run'?+--+-- (Ask \"gurus\" whether @evaluate (length ...)@ approach is+-- better\/more idiomatic.)+getCommandOutput :: String -> IO String+getCommandOutput s = do+  -- we can ignore the process handle because we ignor SIGCHLD+  (pin, pout, perr, _) <- runInteractiveCommand s+  hClose pin+  output <- hGetContents pout+  E.evaluate (length output)+  hClose perr+  return output++stripExt :: String -> String+stripExt = reverse . drop 1 . dropWhile (/= '.') . reverse++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/RunOrRaise.hs view
@@ -0,0 +1,77 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.RunOrRaise+-- Copyright   :  (C) 2008 Justin Bogner+-- License     :  BSD3+--+-- Maintainer  :  mail@justinbogner.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- A prompt for XMonad which will run a program, open a file,+-- or raise an already running program, depending on context.+--+-----------------------------------------------------------------------------++module XMonad.Prompt.RunOrRaise+    ( -- * Usage+      -- $usage+      runOrRaisePrompt+    ) where++import XMonad hiding (config)+import XMonad.Prompt+import XMonad.Prompt.Shell+import XMonad.Actions.WindowGo (runOrRaise)+import XMonad.Util.Run (runProcessWithInput)++import Control.Monad (liftM2)+import Data.Maybe+import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions)++{- $usage+1. In your @~\/.xmonad\/xmonad.hs@:++> import XMonad.Prompt+> import XMonad.Prompt.RunOrRaise++2. In your keybindings add something like:++>   , ((modMask x .|. controlMask, xK_x), runOrRaisePrompt defaultXPConfig)++For detailed instruction on editing the key binding see+"XMonad.Doc.Extending#Editing_key_bindings". -}++data RunOrRaisePrompt = RRP+instance XPrompt RunOrRaisePrompt where+    showXPrompt RRP = "Run or Raise: "++runOrRaisePrompt :: XPConfig -> X ()+runOrRaisePrompt c = do cmds <- io $ getCommands+                        mkXPrompt RRP c (getShellCompl cmds) open+open :: String -> X ()+open path = (io $ isNormalFile path) >>= \b ->+            if b+            then spawn $ "xdg-open \"" ++ path ++ "\""+            else uncurry runOrRaise . getTarget $ path+    where+      isNormalFile f = exists f >>= \e -> if e then (notExecutable f) else return False+      exists f = fmap or $ sequence [doesFileExist f,doesDirectoryExist f]+      notExecutable = fmap (not . executable) . getPermissions+      getTarget x = (x,isApp x)++isApp :: String -> Query Bool+isApp "firefox"     = className =? "Firefox-bin"     <||> className =? "Firefox"+isApp "thunderbird" = className =? "Thunderbird-bin" <||> className =? "Thunderbird"+isApp x = liftM2 (==) pid $ pidof x++pidof :: String -> Query Int+pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` (\_ -> return $ 0)++pid :: Query Int+pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)+    where getPID d w = getAtom "_NET_WM_PID" >>= \a -> io $+                       getWindowProperty32 d a w >>= return . getPID'+          getPID' (Just (x:_)) = fromIntegral x+          getPID' (Just [])     = -1+          getPID' (Nothing)     = -1
+ XMonad/Prompt/Shell.hs view
@@ -0,0 +1,144 @@+-----------------------------------------------------------------------------+-- |+-- 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+      Shell (..)+    , shellPrompt+    , getCommands+    , getBrowser+    , getEditor+    , getShellCompl+    , split+    , prompt+    , safePrompt+    ) where++import System.Environment+import Control.Monad+import Data.List+import System.Directory+import System.IO+import System.Posix.Files+import XMonad.Util.Run+import XMonad hiding (config)+import XMonad.Prompt++-- $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: "+    completionToCommand _ = escape++shellPrompt :: XPConfig -> X ()+shellPrompt c = do+    cmds <- io $ getCommands+    mkXPrompt Shell c (getShellCompl cmds) (spawn . encodeOutput)++-- | See safe and unsafeSpawn. prompt is an alias for safePrompt;+-- safePrompt and unsafePrompt work on the same principles, but will use+-- 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 . encodeOutput+unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run+    where run a = unsafeSpawn $ c ++ " " ++ encodeOutput a++getShellCompl :: [String] -> String -> IO [String]+getShellCompl cmds s | s == "" || last s == ' ' = return []+                     | otherwise                = do+    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file " ++ encodeOutput s ++ "\n")+    files <- case f of+               [x] -> do fs <- getFileStatus x+                         if isDirectory fs then return [x ++ "/"]+                                           else return [x]+               _   -> return f+    return . map decodeInput . uniqSort $ files ++ commandCompletionFunction cmds s++commandCompletionFunction :: [String] -> String -> [String]+commandCompletionFunction cmds str | '/' `elem` str = []+                                   | otherwise      = filter (isPrefixOf str) cmds++getCommands :: IO [String]+getCommands = do+    p  <- getEnv "PATH" `catch` const (return [])+    let ds = split ':' p+    es <- forM ds $ \d -> do+        exists <- doesDirectoryExist d+        if exists+            then getDirectoryContents d+            else return []+    return . uniqSort . filter ((/= '.') . head) . concat $ es++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 (x:xs)+    | isSpecialChar x = '\\' : x : escape xs+    | otherwise       = x : escape xs++isSpecialChar :: Char -> Bool+isSpecialChar =  flip elem " &\\@\"'#?$*()[]{};"++-- | Ask the shell environment for+env :: String -> String -> IO String+env variable fallthrough = getEnv variable `catch` \_ -> return fallthrough++{- | Ask the shell what browser the user likes. If the user hasn't defined any+   $BROWSER, defaults to returning \"firefox\", since that seems to be the most+   common X web browser.+   Note that if you don't specify a GUI browser but a textual one, that'll be a problem+   as 'getBrowser' will be called by functions expecting to be able to just execute the string+   or pass it to a shell; so in that case, define $BROWSER as something like \"xterm -e elinks\"+   or as the name of a shell script doing much the same thing. -}+getBrowser :: IO String+getBrowser = env "BROWSER" "firefox"++-- | Like 'getBrowser', but should be of a text editor. This gets the $EDITOR variable, defaulting to \"emacs\".+getEditor :: IO String+getEditor = env "EDITOR" "emacs"
+ XMonad/Prompt/Ssh.hs view
@@ -0,0 +1,115 @@+-----------------------------------------------------------------------------+-- |+-- 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: "+    commandToComplete _ c = c+    nextCompletion      _ = getNextCompletion++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 (getWithPort . 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++getWithPort :: String -> String+getWithPort ('[':str) = host ++ " -p " ++ port+    where (host,p) = break (==']') str+          port = case p of+                   ']':':':x -> x+                   _         -> "22"+getWithPort  str = str
+ XMonad/Prompt/Theme.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Prompt.Theme+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A prompt for changing the theme of the current workspace+-----------------------------------------------------------------------------++module XMonad.Prompt.Theme+    ( -- * Usage+      -- $usage+      themePrompt,+    ) where++import Control.Arrow ( (&&&) )+import qualified Data.Map as M+import Data.Maybe ( fromMaybe )+import Data.List+import XMonad+import XMonad.Prompt+import XMonad.Layout.Decoration+import XMonad.Util.Themes++-- $usage+-- You can use this module with the following in your+-- @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Prompt+-- > import XMonad.Prompt.Theme+--+-- in your keybindings add:+--+-- >   , ((modMask x .|. controlMask, xK_t), themePrompt defaultXPConfig)+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data ThemePrompt = ThemePrompt++instance XPrompt ThemePrompt where+    showXPrompt ThemePrompt = "Select a theme: "+    commandToComplete _ c = c+    nextCompletion      _ = getNextCompletion++themePrompt :: XPConfig -> X ()+themePrompt c = mkXPrompt ThemePrompt c (mkComplFunFromList' . map ppThemeInfo $ listOfThemes) changeTheme+    where changeTheme t = sendMessage . SetTheme . fromMaybe defaultTheme $ M.lookup t mapOfThemes++mapOfThemes :: M.Map String Theme+mapOfThemes = M.fromList . uncurry zip . (map ppThemeInfo &&& map theme) $ listOfThemes
+ XMonad/Prompt/Window.hs view
@@ -0,0 +1,97 @@+-----------------------------------------------------------------------------+-- |+-- 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,+    windowPromptBringCopy+    ) where++import qualified Data.Map as M+import Data.List++import qualified XMonad.StackSet as W+import XMonad+import XMonad.Prompt+import XMonad.Actions.CopyWindow+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)+--+-- The autoComplete option is a handy complement here:+--+-- > , ((modMask x .|. shiftMask, xK_g     ), windowPromptGoto+-- >                                            defaultXPConfig { autoComplete = Just 500000 } )+--+-- The \'500000\' is the number of microseconds to pause before sending you to+-- your new window. This is useful so that you don't accidentally send some+-- keystrokes to the selected client.+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings".++data WindowPrompt = Goto | Bring | BringCopy+instance XPrompt WindowPrompt where+    showXPrompt Goto      = "Go to window: "+    showXPrompt Bring     = "Bring window: "+    showXPrompt BringCopy = "Bring a copy: "+    commandToComplete _ c = c+    nextCompletion      _ = getNextCompletion++windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X ()+windowPromptGoto  c = doPrompt Goto  c+windowPromptBring c = doPrompt Bring c+windowPromptBringCopy c = doPrompt BringCopy 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  -> fmap gotoAction  windowMap+         Bring -> fmap bringAction windowMap+	 BringCopy -> fmap bringCopyAction windowMap+  wm <- windowMap+  mkXPrompt t c (compList wm) a++    where+      winAction a m    = flip whenJust (windows . a) . flip M.lookup m+      gotoAction       = winAction W.focusWindow+      bringAction      = winAction bringWindow+      bringCopyAction  = winAction bringCopyWindow++      compList m s = return . filter (isPrefixOf s) . map fst . M.toList $ m+++-- | Brings a copy of the specified window into the current workspace.+bringCopyWindow :: Window -> WindowSet -> WindowSet+bringCopyWindow w ws = copyWindow w (W.currentTag $ ws) ws
+ XMonad/Prompt/Workspace.hs view
@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+-- |+-- 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 XMonad hiding ( workspaces )+import XMonad.Prompt+import XMonad.StackSet ( workspaces, tag )+import XMonad.Util.WorkspaceCompare ( getSortByIndex )++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > 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)+                           sort <- getSortByIndex+                           let ts = map tag $ sort 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,54 @@+-----------------------------------------------------------------------------+-- |+-- 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)+import Data.Maybe (fromMaybe)++-- $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+    xmonadPromptC cmds c++-- | An xmonad prompt with a custom command list+xmonadPromptC :: [(String, X ())] -> XPConfig -> X ()+xmonadPromptC commands c =+    mkXPrompt XMonad c (mkComplFunFromList' (map fst commands)) $+        fromMaybe (return ()) . (`lookup` commands)
+ 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,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Dmenu+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A convenient binding to dmenu.+--+-- Requires the process-1.0 package+--+-----------------------------------------------------------------------------++module XMonad.Util.Dmenu (+			    -- * Usage+			    -- $usage+			    dmenu, dmenuXinerama, dmenuMap, menu, menuMap+			   ) 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 = menu "dmenu" opts++menu :: String -> [String] -> X String+menu menuCmd opts = io $ runProcessWithInput menuCmd [] (unlines opts)++menuMap :: String -> M.Map String a -> X (Maybe a)+menuMap menuCmd selectionMap = do+  selection <- menuFunction (M.keys selectionMap)+  return $ M.lookup selection selectionMap+      where+        menuFunction = menu menuCmd++dmenuMap :: M.Map String a -> X (Maybe a)+dmenuMap selectionMap = menuMap "dmenu" selectionMap
+ XMonad/Util/Dzen.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- 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,709 @@+--------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.EZConfig+-- Copyright   :  Devin Mullins <me@twifkak.com>+--                Brent Yorgey <byorgey@gmail.com> (key parsing)+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Devin Mullins <me@twifkak.com>+--+-- Useful helper functions for amending the defaultConfig, and for+-- parsing keybindings specified in a special (emacs-like) format.+--+-- (See also "XMonad.Util.CustomKeys" in xmonad-contrib.)+--+--------------------------------------------------------------------++module XMonad.Util.EZConfig (+                             -- * Usage+                             -- $usage++                             -- * Adding or removing keybindings++                             additionalKeys, additionalKeysP,+                             removeKeys, removeKeysP,+                             additionalMouseBindings, removeMouseBindings,++                             -- * Emacs-style keybinding specifications++                             mkKeymap, checkKeymap,+                            ) where++import XMonad+import XMonad.Actions.Submap++import qualified Data.Map as M+import Data.List (foldl', intersperse, sortBy, groupBy, nub)+import Data.Ord (comparing)+import Data.Maybe+import Control.Arrow (first, (&&&))++import Text.ParserCombinators.ReadP++-- $usage+-- To use this module, first import it into your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Util.EZConfig+--+-- Then, use one of the provided functions to modify your+-- configuration.  You can use 'additionalKeys', 'removeKeys',+-- 'additionalMouseBindings', and 'removeMouseBindings' to easily add+-- and remove keybindings or mouse bindings.  You can use 'mkKeymap'+-- to create a keymap using emacs-style keybinding specifications+-- like @\"M-x\"@ instead of @(modMask, xK_x)@, or 'additionalKeysP'+-- and 'removeKeysP' to easily add or remove emacs-style keybindings.+-- If you use emacs-style keybindings, the 'checkKeymap' function is+-- provided, suitable for adding to your 'startupHook', which can warn+-- you of any parse errors or duplicate bindings in your keymap.+--+-- For more information and usage eamples, see the documentation+-- provided with each exported function, and check the xmonad config+-- archive (<http://haskell.org/haskellwiki/Xmonad/Config_archive>)+-- for some real examples of use.++-- |+-- Add or override keybindings from the existing set. Example use:+--+-- > 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 keyList =+    conf { keys = \cnf -> M.union (M.fromList keyList) (keys conf cnf) }++-- | Like 'additionalKeys', except using short @String@ key+--   descriptors like @\"M-m\"@ instead of @(modMask, xK_m)@, as+--   described in the documentation for 'mkKeymap'.  For example:+--+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }+-- >                 `additionalKeysP`+-- >                 [ ("M-m", spawn "echo 'Hi, mom!' | dzen2 -p 4")+-- >                 , ("M-<Backspace>", withFocused hide) -- N.B. this is an absurd thing to do+-- >                 ]++additionalKeysP :: XConfig l -> [(String, X ())] -> XConfig l+additionalKeysP conf keyList =+    conf { keys = \cnf -> M.union (mkKeymap cnf keyList) (keys conf cnf) }++-- |+-- Remove standard keybindings you're not using. Example use:+--+-- > 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 'removeKeys', except using short @String@ key descriptors+--   like @\"M-m\"@ instead of @(modMask, xK_m)@, as described in the+--   documentation for 'mkKeymap'. For example:+--+-- > main = xmonad $ defaultConfig { terminal = "urxvt" }+-- >                 `removeKeysP` ["M-S-" ++ [n] | n <- ['1'..'9']]++removeKeysP :: XConfig l -> [String] -> XConfig l+removeKeysP conf keyList =+    conf { keys = \cnf -> keys conf cnf `M.difference` mkKeymap cnf (zip keyList $ repeat (return ())) }++-- | Like 'additionalKeys', but for mouse bindings.+additionalMouseBindings :: XConfig a -> [((ButtonMask, Button), Window -> X ())] -> XConfig a+additionalMouseBindings conf mouseBindingsList =+    conf { mouseBindings = \cnf -> M.union (M.fromList mouseBindingsList) (mouseBindings conf cnf) }++-- | Like 'removeKeys', but for mouse bindings.+removeMouseBindings :: XConfig a -> [(ButtonMask, Button)] -> XConfig a+removeMouseBindings conf mouseBindingList =+    conf { mouseBindings = \cnf -> mouseBindings conf cnf `M.difference`+                                   M.fromList (zip mouseBindingList $ return ()) }+++--------------------------------------------------------------+--  Keybinding parsing  ---------------------------------------+--------------------------------------------------------------++-- | Given a config (used to determine the proper modifier key to use)+--   and a list of @(String, X ())@ pairs, create a key map by parsing+--   the key sequence descriptions contained in the Strings.  The key+--   sequence descriptions are \"emacs-style\": @M-@, @C-@, @S-@, and+--   @M\#-@ denote mod, control, shift, and mod1-mod5 (where @\#@ is+--   replaced by the appropriate number) respectively.  Note that if+--   you want to make a keybinding using \'alt\' even though you use a+--   different key (like the \'windows\' key) for \'mod\', you can use+--   something like @\"M1-x\"@ for alt+x (check the output of @xmodmap@+--   to see which mod key \'alt\' is bound to). Some special keys can+--   also be specified by enclosing their name in angle brackets.+--+--   For example, @\"M-C-x\"@ denotes mod+ctrl+x; @\"S-\<Escape\>\"@+--   denotes shift-escape; @\"M1-C-\<Delete\>\"@ denotes alt+ctrl+delete+--   (assuming alt is bound to mod1, which is common).+--+--   Sequences of keys can also be specified by separating the key+--   descriptions with spaces. For example, @\"M-x y \<Down\>\"@ denotes the+--   sequence of keys mod+x, y, down.  Submaps (see+--   "XMonad.Actions.Submap") will be automatically generated to+--   correctly handle these cases.+--+--   So, for example, a complete key map might be specified as+--+-- > keys = \c -> mkKeymap c $+-- >     [ ("M-S-<Return>", spawn $ terminal c)+-- >     , ("M-x w", spawn "xmessage 'woohoo!'")  -- type mod+x then w to pop up 'woohoo!'+-- >     , ("M-x y", spawn "xmessage 'yay!'")     -- type mod+x then y to pop up 'yay!'+-- >     , ("M-S-c", kill)+-- >     ]+--+-- Alternatively, you can use 'additionalKeysP' to automatically+-- create a keymap and add it to your config.+--+-- Here is a complete list of supported special keys.  Note that a few+-- keys, such as the arrow keys, have synonyms.  If there are other+-- special keys you would like to see supported, feel free to submit a+-- patch, or ask on the xmonad mailing list; adding special keys is+-- quite simple.+--+-- > <Backspace>+-- > <Tab>+-- > <Return>+-- > <Pause>+-- > <Scroll_lock>+-- > <Sys_Req>+-- > <Print>+-- > <Escape>, <Esc>+-- > <Delete>+-- > <Home>+-- > <Left>, <L>+-- > <Up>, <U>+-- > <Right>, <R>+-- > <Down>, <D>+-- > <Page_Up>+-- > <Page_Down>+-- > <End>+-- > <Insert>+-- > <Break>+-- > <Space>+-- > <F1>-<F24>+-- > <KP_Space>+-- > <KP_Tab>+-- > <KP_Enter>+-- > <KP_F1>+-- > <KP_F2>+-- > <KP_F3>+-- > <KP_F4>+-- > <KP_Home>+-- > <KP_Left>+-- > <KP_Up>+-- > <KP_Right>+-- > <KP_Down>+-- > <KP_Prior>+-- > <KP_Page_Up>+-- > <KP_Next>+-- > <KP_Page_Down>+-- > <KP_End>+-- > <KP_Begin>+-- > <KP_Insert>+-- > <KP_Delete>+-- > <KP_Equal>+-- > <KP_Multiply>+-- > <KP_Add>+-- > <KP_Separator>+-- > <KP_Subtract>+-- > <KP_Decimal>+-- > <KP_Divide>+-- > <KP_0>-<KP_9>+--+-- Long list of multimedia keys. Please note that not all keys may be+-- present in your particular setup althrough most likely they will do.+--+-- > <XF86ModeLock>+-- > <XF86MonBrightnessUp>+-- > <XF86MonBrightnessDown>+-- > <XF86KbdLightOnOff>+-- > <XF86KbdBrightnessUp>+-- > <XF86KbdBrightnessDown>+-- > <XF86Standby>+-- > <XF86AudioLowerVolume>+-- > <XF86AudioMute>+-- > <XF86AudioRaiseVolume>+-- > <XF86AudioPlay>+-- > <XF86AudioStop>+-- > <XF86AudioPrev>+-- > <XF86AudioNext>+-- > <XF86HomePage>+-- > <XF86Mail>+-- > <XF86Start>+-- > <XF86Search>+-- > <XF86AudioRecord>+-- > <XF86Calculator>+-- > <XF86Memo>+-- > <XF86ToDoList>+-- > <XF86Calendar>+-- > <XF86PowerDown>+-- > <XF86ContrastAdjust>+-- > <XF86RockerUp>+-- > <XF86RockerDown>+-- > <XF86RockerEnter>+-- > <XF86Back>+-- > <XF86Forward>+-- > <XF86Stop>+-- > <XF86Refresh>+-- > <XF86PowerOff>+-- > <XF86WakeUp>+-- > <XF86Eject>+-- > <XF86ScreenSaver>+-- > <XF86WWW>+-- > <XF86Sleep>+-- > <XF86Favorites>+-- > <XF86AudioPause>+-- > <XF86AudioMedia>+-- > <XF86MyComputer>+-- > <XF86VendorHome>+-- > <XF86LightBulb>+-- > <XF86Shop>+-- > <XF86History>+-- > <XF86OpenURL>+-- > <XF86AddFavorite>+-- > <XF86HotLinks>+-- > <XF86BrightnessAdjust>+-- > <XF86Finance>+-- > <XF86Community>+-- > <XF86AudioRewind>+-- > <XF86XF86BackForward>+-- > <XF86Launch0>-<XF86Launch9>, <XF86LaunchA>-<XF86LaunchF>+-- > <XF86ApplicationLeft>+-- > <XF86ApplicationRight>+-- > <XF86Book>+-- > <XF86CD>+-- > <XF86Calculater>+-- > <XF86Clear>+-- > <XF86Close>+-- > <XF86Copy>+-- > <XF86Cut>+-- > <XF86Display>+-- > <XF86DOS>+-- > <XF86Documents>+-- > <XF86Excel>+-- > <XF86Explorer>+-- > <XF86Game>+-- > <XF86Go>+-- > <XF86iTouch>+-- > <XF86LogOff>+-- > <XF86Market>+-- > <XF86Meeting>+-- > <XF86MenuKB>+-- > <XF86MenuPB>+-- > <XF86MySites>+-- > <XF86New>+-- > <XF86News>+-- > <XF86OfficeHome>+-- > <XF86Open>+-- > <XF86Option>+-- > <XF86Paste>+-- > <XF86Phone>+-- > <XF86Q>+-- > <XF86Reply>+-- > <XF86Reload>+-- > <XF86RotateWindows>+-- > <XF86RotationPB>+-- > <XF86RotationKB>+-- > <XF86Save>+-- > <XF86ScrollUp>+-- > <XF86ScrollDown>+-- > <XF86ScrollClick>+-- > <XF86Send>+-- > <XF86Spell>+-- > <XF86SplitScreen>+-- > <XF86Support>+-- > <XF86TaskPane>+-- > <XF86Terminal>+-- > <XF86Tools>+-- > <XF86Travel>+-- > <XF86UserPB>+-- > <XF86User1KB>+-- > <XF86User2KB>+-- > <XF86Video>+-- > <XF86WheelButton>+-- > <XF86Word>+-- > <XF86Xfer>+-- > <XF86ZoomIn>+-- > <XF86ZoomOut>+-- > <XF86Away>+-- > <XF86Messenger>+-- > <XF86WebCam>+-- > <XF86MailForward>+-- > <XF86Pictures>+-- > <XF86Music>+-- > <XF86_Switch_VT_1>-<XF86_Switch_VT_12>+-- > <XF86_Ungrab>+-- > <XF86_ClearGrab>+-- > <XF86_Next_VMode>+-- > <XF86_Prev_VMode>++mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())+mkKeymap c = M.fromList . mkSubmaps . readKeymap c++-- | Given a list of pairs of parsed key sequences and actions,+--   group them into submaps in the appropriate way.+mkSubmaps :: [ ([(KeyMask,KeySym)], X ()) ] -> [((KeyMask, KeySym), X ())]+mkSubmaps binds = map combine gathered+  where gathered = groupBy fstKey+                 . sortBy (comparing fst)+                 $ binds+        combine [([k],act)] = (k,act)+        combine ks = (head . fst . head $ ks,+                      submap . M.fromList . mkSubmaps $ map (first tail) ks)+        fstKey = (==) `on` (head . fst)++on :: (a -> a -> b) -> (c -> a) -> c -> c -> b+op `on` f = \x y -> f x `op` f y++-- | Given a configuration record and a list of (key sequence+--   description, action) pairs, parse the key sequences into lists of+--   @(KeyMask,KeySym)@ pairs.  Key sequences which fail to parse will+--   be ignored.+readKeymap :: XConfig l -> [(String, X())] -> [([(KeyMask,KeySym)], X())]+readKeymap c = mapMaybe (maybeKeys . first (readKeySequence c))+  where maybeKeys (Nothing,_) = Nothing+        maybeKeys (Just k, act) = Just (k, act)++-- | Parse a sequence of keys, returning Nothing if there is+--   a parse failure (no parse, or ambiguous parse).+readKeySequence :: XConfig l -> String -> Maybe [(KeyMask, KeySym)]+readKeySequence c = listToMaybe . parses+  where parses = map fst . filter (null.snd) . readP_to_S (parseKeySequence c)++-- | Parse a sequence of key combinations separated by spaces, e.g.+--   @\"M-c x C-S-2\"@ (mod+c, x, ctrl+shift+2).+parseKeySequence :: XConfig l -> ReadP [(KeyMask, KeySym)]+parseKeySequence c = sepBy1 (parseKeyCombo c) (many1 $ char ' ')++-- | Parse a modifier-key combination such as "M-C-s" (mod+ctrl+s).+parseKeyCombo :: XConfig l -> ReadP (KeyMask, KeySym)+parseKeyCombo c = do mods <- many (parseModifier c)+                     k <- parseKey+                     return (foldl' (.|.) 0 mods, k)++-- | Parse a modifier: either M- (user-defined mod-key),+--   C- (control), S- (shift), or M#- where # is an integer+--   from 1 to 5 (mod1Mask through mod5Mask).+parseModifier :: XConfig l -> ReadP KeyMask+parseModifier c =  (string "M-" >> return (modMask c))+               +++ (string "C-" >> return controlMask)+               +++ (string "S-" >> return shiftMask)+               +++ do char 'M'+                      n <- satisfy (`elem` ['1'..'5'])+                      char '-'+                      return (mod1Mask + (read [n]) - 1)++-- | Parse an unmodified basic key, like @\"x\"@, @\"<F1>\"@, etc.+parseKey :: ReadP KeySym+parseKey = parseRegular +++ parseSpecial++-- | Parse a regular key name (represented by itself).+parseRegular :: ReadP KeySym+parseRegular = choice [ char s >> return k+                      | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde]+                      ]++-- | Parse a special key name (one enclosed in angle brackets).+parseSpecial :: ReadP KeySym+parseSpecial = do char '<'+                  key <- choice [ string name >> return k+                                | (name,k) <- keyNames+                                ]+                  char '>'+                  return key++-- | A list of all special key names and their associated KeySyms.+keyNames :: [(String, KeySym)]+keyNames = functionKeys ++ specialKeys ++ multimediaKeys++-- | A list pairing function key descriptor strings (e.g. @\"<F2>\"@) with+--   the associated KeySyms.+functionKeys :: [(String, KeySym)]+functionKeys = [ ("F" ++ show n, k)+               | (n,k) <- zip ([1..24] :: [Int]) [xK_F1..] ]++-- | A list of special key names and their corresponding KeySyms.+specialKeys :: [(String, KeySym)]+specialKeys = [ ("Backspace"  , xK_BackSpace)+              , ("Tab"        , xK_Tab)+              , ("Return"     , xK_Return)+              , ("Pause"      , xK_Pause)+              , ("Scroll_lock", xK_Scroll_Lock)+              , ("Sys_Req"    , xK_Sys_Req)+              , ("Print"      , xK_Print)+              , ("Escape"     , xK_Escape)+              , ("Esc"        , xK_Escape)+              , ("Delete"     , xK_Delete)+              , ("Home"       , xK_Home)+              , ("Left"       , xK_Left)+              , ("Up"         , xK_Up)+              , ("Right"      , xK_Right)+              , ("Down"       , xK_Down)+              , ("L"          , xK_Left)+              , ("U"          , xK_Up)+              , ("R"          , xK_Right)+              , ("D"          , xK_Down)+              , ("Page_Up"    , xK_Page_Up)+              , ("Page_Down"  , xK_Page_Down)+              , ("End"        , xK_End)+              , ("Insert"     , xK_Insert)+              , ("Break"      , xK_Break)+              , ("Space"      , xK_space)+              , ("KP_Space"   , xK_KP_Space)+              , ("KP_Tab"     , xK_KP_Tab)+              , ("KP_Enter"   , xK_KP_Enter)+              , ("KP_F1"      , xK_KP_F1)+              , ("KP_F2"      , xK_KP_F2)+              , ("KP_F3"      , xK_KP_F3)+              , ("KP_F4"      , xK_KP_F4)+              , ("KP_Home"    , xK_KP_Home)+              , ("KP_Left"    , xK_KP_Left)+              , ("KP_Up"      , xK_KP_Up)+              , ("KP_Right"   , xK_KP_Right)+              , ("KP_Down"    , xK_KP_Down)+              , ("KP_Prior"   , xK_KP_Prior)+              , ("KP_Page_Up" , xK_KP_Page_Up)+              , ("KP_Next"    , xK_KP_Next)+              , ("KP_Page_Down", xK_KP_Page_Down)+              , ("KP_End"     , xK_KP_End)+              , ("KP_Begin"   , xK_KP_Begin)+              , ("KP_Insert"  , xK_KP_Insert)+              , ("KP_Delete"  , xK_KP_Delete)+              , ("KP_Equal"   , xK_KP_Equal)+              , ("KP_Multiply", xK_KP_Multiply)+              , ("KP_Add"     , xK_KP_Add)+              , ("KP_Separator", xK_KP_Separator)+              , ("KP_Subtract", xK_KP_Subtract)+              , ("KP_Decimal" , xK_KP_Decimal)+              , ("KP_Divide"  , xK_KP_Divide)+              , ("KP_0"       , xK_KP_0)+              , ("KP_1"       , xK_KP_1)+              , ("KP_2"       , xK_KP_2)+              , ("KP_3"       , xK_KP_3)+              , ("KP_4"       , xK_KP_4)+              , ("KP_5"       , xK_KP_5)+              , ("KP_6"       , xK_KP_6)+              , ("KP_7"       , xK_KP_7)+              , ("KP_8"       , xK_KP_8)+              , ("KP_9"       , xK_KP_9)+              ]++-- | List of multimedia keys. If X server does not know about some+-- | keysym it's omitted from list. (stringToKeysym returns noSymbol in this case)+multimediaKeys :: [(String, KeySym)]+multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $+                 [ "XF86ModeLock"+                 , "XF86MonBrightnessUp"+                 , "XF86MonBrightnessDown"+                 , "XF86KbdLightOnOff"+                 , "XF86KbdBrightnessUp"+                 , "XF86KbdBrightnessDown"+                 , "XF86Standby"+                 , "XF86AudioLowerVolume"+                 , "XF86AudioMute"+                 , "XF86AudioRaiseVolume"+                 , "XF86AudioPlay"+                 , "XF86AudioStop"+                 , "XF86AudioPrev"+                 , "XF86AudioNext"+                 , "XF86HomePage"+                 , "XF86Mail"+                 , "XF86Start"+                 , "XF86Search"+                 , "XF86AudioRecord"+                 , "XF86Calculator"+                 , "XF86Memo"+                 , "XF86ToDoList"+                 , "XF86Calendar"+                 , "XF86PowerDown"+                 , "XF86ContrastAdjust"+                 , "XF86RockerUp"+                 , "XF86RockerDown"+                 , "XF86RockerEnter"+                 , "XF86Back"+                 , "XF86Forward"+                 , "XF86Stop"+                 , "XF86Refresh"+                 , "XF86PowerOff"+                 , "XF86WakeUp"+                 , "XF86Eject"+                 , "XF86ScreenSaver"+                 , "XF86WWW"+                 , "XF86Sleep"+                 , "XF86Favorites"+                 , "XF86AudioPause"+                 , "XF86AudioMedia"+                 , "XF86MyComputer"+                 , "XF86VendorHome"+                 , "XF86LightBulb"+                 , "XF86Shop"+                 , "XF86History"+                 , "XF86OpenURL"+                 , "XF86AddFavorite"+                 , "XF86HotLinks"+                 , "XF86BrightnessAdjust"+                 , "XF86Finance"+                 , "XF86Community"+                 , "XF86AudioRewind"+                 , "XF86BackForward"+                 , "XF86Launch0"+                 , "XF86Launch1"+                 , "XF86Launch2"+                 , "XF86Launch3"+                 , "XF86Launch4"+                 , "XF86Launch5"+                 , "XF86Launch6"+                 , "XF86Launch7"+                 , "XF86Launch8"+                 , "XF86Launch9"+                 , "XF86LaunchA"+                 , "XF86LaunchB"+                 , "XF86LaunchC"+                 , "XF86LaunchD"+                 , "XF86LaunchE"+                 , "XF86LaunchF"+                 , "XF86ApplicationLeft"+                 , "XF86ApplicationRight"+                 , "XF86Book"+                 , "XF86CD"+                 , "XF86Calculater"+                 , "XF86Clear"+                 , "XF86Close"+                 , "XF86Copy"+                 , "XF86Cut"+                 , "XF86Display"+                 , "XF86DOS"+                 , "XF86Documents"+                 , "XF86Excel"+                 , "XF86Explorer"+                 , "XF86Game"+                 , "XF86Go"+                 , "XF86iTouch"+                 , "XF86LogOff"+                 , "XF86Market"+                 , "XF86Meeting"+                 , "XF86MenuKB"+                 , "XF86MenuPB"+                 , "XF86MySites"+                 , "XF86New"+                 , "XF86News"+                 , "XF86OfficeHome"+                 , "XF86Open"+                 , "XF86Option"+                 , "XF86Paste"+                 , "XF86Phone"+                 , "XF86Q"+                 , "XF86Reply"+                 , "XF86Reload"+                 , "XF86RotateWindows"+                 , "XF86RotationPB"+                 , "XF86RotationKB"+                 , "XF86Save"+                 , "XF86ScrollUp"+                 , "XF86ScrollDown"+                 , "XF86ScrollClick"+                 , "XF86Send"+                 , "XF86Spell"+                 , "XF86SplitScreen"+                 , "XF86Support"+                 , "XF86TaskPane"+                 , "XF86Terminal"+                 , "XF86Tools"+                 , "XF86Travel"+                 , "XF86UserPB"+                 , "XF86User1KB"+                 , "XF86User2KB"+                 , "XF86Video"+                 , "XF86WheelButton"+                 , "XF86Word"+                 , "XF86Xfer"+                 , "XF86ZoomIn"+                 , "XF86ZoomOut"+                 , "XF86Away"+                 , "XF86Messenger"+                 , "XF86WebCam"+                 , "XF86MailForward"+                 , "XF86Pictures"+                 , "XF86Music"+                 , "XF86_Switch_VT_1"+                 , "XF86_Switch_VT_2"+                 , "XF86_Switch_VT_3"+                 , "XF86_Switch_VT_4"+                 , "XF86_Switch_VT_5"+                 , "XF86_Switch_VT_6"+                 , "XF86_Switch_VT_7"+                 , "XF86_Switch_VT_8"+                 , "XF86_Switch_VT_9"+                 , "XF86_Switch_VT_10"+                 , "XF86_Switch_VT_11"+                 , "XF86_Switch_VT_12"+                 , "XF86_Ungrab"+                 , "XF86_ClearGrab"+                 , "XF86_Next_VMode"+                 , "XF86_Prev_VMode" ]++-- | Given a configuration record and a list of (key sequence+--   description, action) pairs, check the key sequence descriptions+--   for validity, and warn the user (via a popup xmessage window) of+--   any unparseable or duplicate key sequences.  This function is+--   appropriate for adding to your @startupHook@, and you are highly+--   encouraged to do so; otherwise, duplicate or unparseable+--   keybindings will be silently ignored.+--+--   For example, you might do something like this:+--+-- > main = xmonad $ myConfig+-- >+-- > myKeymap = [("S-M-c", kill), ...]+-- > myConfig = defaultConfig {+-- >     ...+-- >     keys = \c -> mkKeymap c myKeymap+-- >     startupHook = return () >> checkKeymap myConfig myKeymap+-- >     ...+-- > }+--+-- NOTE: the @return ()@ in the example above is very important!+-- Otherwise, you might run into problems with infinite mutual+-- recursion: the definition of myConfig depends on the definition of+-- startupHook, which depends on the definition of myConfig, ... and+-- so on.  Actually, it's likely that the above example in particular+-- would be OK without the @return ()@, but making @myKeymap@ take+-- @myConfig@ as a parameter would definitely lead to+-- problems. Believe me.  It, uh, happened to my friend. In... a+-- dream. Yeah. In any event, the @return () >>@ introduces enough+-- laziness to break the deadlock.+--+checkKeymap :: XConfig l -> [(String, a)] -> X ()+checkKeymap conf km = warn (doKeymapCheck conf km)+  where warn ([],[])   = return ()+        warn (bad,dup) = spawn $ "xmessage 'Warning:\n"+                            ++ msg "bad" bad ++ "\n"+                            ++ msg "duplicate" dup ++ "'"+        msg _ [] = ""+        msg m xs = m ++ " keybindings detected: " ++ showBindings xs+        showBindings = concat . intersperse " " . map ((++"\"") . ("\""++))++-- | Given a config and a list of (key sequence description, action)+--   pairs, check the key sequence descriptions for validity,+--   returning a list of unparseable key sequences, and a list of+--   duplicate key sequences.+doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])+doKeymapCheck conf km = (bad,dups)+  where ks = map ((readKeySequence conf &&& id) . fst) km+        bad = nub . map snd . filter (isNothing . fst) $ ks+        dups = map (snd . head)+             . filter ((>1) . length)+             . groupBy ((==) `on` fst)+             . sortBy (comparing fst)+             . map (first fromJust)+             . filter (isJust . fst)+             $ ks
+ XMonad/Util/Font.hsc view
@@ -0,0 +1,214 @@+----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Font+-- Copyright   :  (c) 2007 Andrea Rossato and Spencer Janssen+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for abstracting a font facility over Core fonts and Xft+--+-----------------------------------------------------------------------------++module XMonad.Util.Font+    ( -- * Usage:+      -- $usage+      XMonadFont(..)+    , initXMF+    , releaseXMF+    , initCoreFont+    , releaseCoreFont+    , initUtf8Font+    , releaseUtf8Font+    , Align (..)+    , stringPosition+    , textWidthXMF+    , textExtentsXMF+    , printStringXMF+    , stringToPixel+    , decodeInput+    , encodeOutput+    ) where++import XMonad+import Foreign+import Control.Applicative+import Data.Maybe++#ifdef XFT+import Data.List+import Graphics.X11.Xft+import Graphics.X11.Xrender+#endif++#if defined XFT || defined USE_UTF8+import Codec.Binary.UTF8.String (encodeString, decodeString)+#endif++-- Hide the Core Font/Xft switching here+data XMonadFont = Core FontStruct+                | Utf8 FontSet+#ifdef XFT+                | Xft  XftFont+#endif++-- $usage+-- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples++-- | Get the Pixel value for a named color: if an invalid name is+-- given the black pixel will be returned.+stringToPixel :: (Functor m, MonadIO m) => Display -> String -> m Pixel+stringToPixel d s = fromMaybe fallBack <$> io getIt+    where getIt    = initColor d s+          fallBack = blackPixel d (defaultScreen d)+++-- | Given a fontname returns the font structure. If the font name is+--  not valid the default font will be loaded and returned.+initCoreFont :: String -> X FontStruct+initCoreFont s = do+  d <- asks display+  io $ catch (getIt d) (fallBack d)+      where getIt    d = loadQueryFont d s+            fallBack d = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++releaseCoreFont :: FontStruct -> X ()+releaseCoreFont fs = do+  d <- asks display+  io $ freeFont d fs++initUtf8Font :: String -> X FontSet+initUtf8Font s = do+  d <- asks display+  (_,_,fs) <- io $ catch (getIt d) (fallBack d)+  return fs+      where getIt    d = createFontSet d s+            fallBack d = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++releaseUtf8Font :: FontSet -> X ()+releaseUtf8Font fs = do+  d <- asks display+  io $ freeFontSet d fs++-- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend+-- Example: 'xft: Sans-10'+initXMF :: String -> X XMonadFont+initXMF s =+#ifdef XFT+  if xftPrefix `isPrefixOf` s then+     do dpy <- asks display+        xftdraw <- io $ xftFontOpen dpy (defaultScreenOfDisplay dpy) (drop (length xftPrefix) s)+        return (Xft xftdraw)+  else+#endif+#ifdef USE_UTF8+      fmap Utf8 $ initUtf8Font s+#else+      fmap Core $ initCoreFont s+#endif+#ifdef XFT+  where xftPrefix = "xft:"+#endif++releaseXMF :: XMonadFont -> X ()+#ifdef XFT+releaseXMF (Xft xftfont) = do+  dpy <- asks display+  io $ xftFontClose dpy xftfont+#endif+releaseXMF (Utf8 fs) = releaseUtf8Font fs+releaseXMF (Core fs) = releaseCoreFont fs+++textWidthXMF :: MonadIO m => Display -> XMonadFont -> String -> m Int+textWidthXMF _   (Utf8 fs) s = return $ fi $ wcTextEscapement fs s+textWidthXMF _   (Core fs) s = return $ fi $ textWidth fs s+#ifdef XFT+textWidthXMF dpy (Xft xftdraw) s = liftIO $ do+    gi <- xftTextExtents dpy xftdraw s+    return $ xglyphinfo_xOff gi+#endif++textExtentsXMF :: MonadIO m => XMonadFont -> String -> m (Int32,Int32)+textExtentsXMF (Utf8 fs) s = do+  let (_,rl)  = wcTextExtents fs s+      ascent  = fi $ - (rect_y rl)+      descent = fi $ rect_height rl + (fi $ rect_y rl)+  return (ascent, descent)+textExtentsXMF (Core fs) s = do+  let (_,a,d,_) = textExtents fs s+  return (a,d)+#ifdef XFT+textExtentsXMF (Xft xftfont) _ = io $ do+  ascent  <- fi `fmap` xftfont_ascent  xftfont+  descent <- fi `fmap` xftfont_descent xftfont+  return (ascent, descent)+#endif++-- | String position+data Align = AlignCenter | AlignRight | AlignLeft | AlignRightOffset Int++-- | Return the string x and y 'Position' in a 'Rectangle', given a+-- 'FontStruct' and the 'Align'ment+stringPosition :: (Functor m, MonadIO m) => Display -> XMonadFont -> Rectangle -> Align -> String -> m (Position,Position)+stringPosition dpy fs (Rectangle _ _ w h) al s = do+  width <- textWidthXMF dpy fs s+  (a,d) <- textExtentsXMF fs s+  let y = fi $ ((h - fi (a + d)) `div` 2) + fi a;+      x = case al of+            AlignCenter -> fi (w `div` 2) - fi (width `div` 2)+            AlignLeft   -> 1+            AlignRight  -> fi (w - (fi width + 1));+            AlignRightOffset offset -> fi (w - (fi width + 1)) - fi offset;+  return (x,y)++printStringXMF :: (Functor m, MonadIO m) => Display -> Drawable -> XMonadFont -> GC -> String -> String+            -> Position -> Position -> String  -> m ()+printStringXMF d p (Core fs) gc fc bc x y s = io $ do+    setFont d gc $ fontFromFontStruct fs+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]+    setForeground d gc fc'+    setBackground d gc bc'+    drawImageString d p gc x y s+printStringXMF d p (Utf8 fs) gc fc bc x y s = io $ do+    [fc',bc'] <- mapM (stringToPixel d) [fc,bc]+    setForeground d gc fc'+    setBackground d gc bc'+    io $ wcDrawImageString d p fs gc x y s+#ifdef XFT+printStringXMF dpy drw fs@(Xft font) gc fc bc x y s = do+  let screen   = defaultScreenOfDisplay dpy+      colormap = defaultColormapOfScreen screen+      visual   = defaultVisualOfScreen screen+  bcolor <- stringToPixel dpy bc+  (a,d)  <- textExtentsXMF fs s+  gi <- io $ xftTextExtents dpy font s+  io $ setForeground dpy gc bcolor+  io $ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))+                                (y - fi a)+                                (fi $ xglyphinfo_xOff gi)+                                (fi $ a + d)+  io $ withXftDraw dpy drw visual colormap $+         \draw -> withXftColorName dpy visual colormap fc $+                   \color -> xftDrawString draw color font x y s+#endif++decodeInput :: String -> String+#if defined XFT || defined USE_UTF8+decodeInput = decodeString+#else+decodeInput = id+#endif++encodeOutput :: String -> String+#if defined XFT || defined USE_UTF8+encodeOutput = encodeString+#else+encodeOutput = id+#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/Loggers.hs view
@@ -0,0 +1,298 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Loggers+-- Copyright   :  (c) Brent Yorgey, Wirt Wolff+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <byorgey@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- A collection of simple logger functions and formatting utilities+-- which can be used in the 'XMonad.Hooks.DynamicLog.ppExtras' field of+-- a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog"+-- for more information.+-----------------------------------------------------------------------------++module XMonad.Util.Loggers (+    -- * Usage+    -- $usage++      Logger++    -- * System Loggers+    -- $system+    , aumixVolume+    , battery+    , date+    , loadAvg+    , maildirNew, maildirUnread+    , logCmd , logFileCount++    -- * XMonad Loggers+    -- $xmonad+    , logCurrent, logLayout, logTitle++    -- * Formatting Utilities+    -- $format+    , onLogger+    , wrapL, fixedWidthL+    , logSp, padL+    , shortenL+    , dzenColorL, xmobarColorL++    , (<$>)++  ) where++import XMonad (liftIO)+import XMonad.Core+import qualified XMonad.StackSet as W+import XMonad.Hooks.DynamicLog+import XMonad.Util.Font (Align (..))+import XMonad.Util.NamedWindows (getName)++import Control.Applicative ((<$>))+import Data.List (isPrefixOf, isSuffixOf)+import Data.Maybe (fromMaybe)+import Data.Traversable (traverse)+import System.Directory (getDirectoryContents)+import System.IO+import System.Locale+import System.Process (runInteractiveCommand)+import System.Time++-- $usage+-- Use this module by importing it into your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Util.Loggers+--+-- Then, add one or more loggers to the+-- 'XMonad.Hooks.DynamicLog.ppExtras' field of your+-- 'XMonad.Hooks.DynamicLoc.PP', possibly with extra formatting .+-- For example:+--+-- >   -- display load averages and a pithy quote along with xmonad status.+-- >   , logHook = dynamicLogWithPP $ defaultPP {+-- >                  ppExtras = [ padL loadAvg, logCmd "fortune -n 40 -s" ]+-- >                }+-- >   -- gives something like " 3.27 3.52 3.26 Drive defensively.  Buy a tank."+--+-- See the formatting section below for another example using+-- a @where@ block to define some formatted loggers for a top-level+-- @myLogHook@.+--+-- Loggers are named either for their function, as in 'battery',+-- 'aumixVolume', and 'maildirNew', or are prefixed with \"log\" when+-- making use of other functions or by analogy with the pp* functions.+-- For example, the logger version of 'XMonad.Hooks.DynamicLog.ppTitle'+-- is 'logTitle', and 'logFileCount' loggerizes the result of file+-- counting code.+--+-- Formatting utility names are generally as short as possible and+-- carry the suffix \"L\". For example, the logger version of+-- 'XMonad.Hooks.DynamicLog.shorten' is 'shortenL'.+--+-- Of course, there is nothing really special about these so-called+-- \"loggers\": they are just @X (Maybe String)@ actions.  So you can+-- use them anywhere you would use an @X (Maybe String)@, not just+-- with DynamicLog.+--+-- Additional loggers welcome!++++-- | 'Logger' is just a convenient synonym for @X (Maybe String)@.+type Logger = X (Maybe String)++-- $system++-- | Get the current volume with @aumix@. <http://jpj.net/~trevor/aumix.html>+aumixVolume :: Logger+aumixVolume = logCmd "aumix -vq"++-- | Get the battery status (percent charge and charging\/discharging+--   status). This is an ugly hack and may not work for some people.+--   At some point it would be nice to make this more general\/have+--   fewer dependencies (assumes @\/usr\/bin\/acpi@ and @sed@ are installed.)+battery :: Logger+battery = logCmd "/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/discharging, ([0-9]+%)/\\1-/; s/charging, ([0-9]+%)/\\1+/; s/charged, //'"++-- | Get the current date and time, and format them via the+--   given format string.  The format used is the same as that used+--   by the C library function strftime; for example,+--   @date \"%a %b %d\"@ might display something like @Tue Feb 19@.+--   For more information see something like+--   <http://www.cplusplus.com/reference/clibrary/ctime/strftime.html>.+date :: String -> Logger+date fmt = io $ do cal <- (getClockTime >>= toCalendarTime)+                   return . Just $ formatCalendarTime defaultTimeLocale fmt cal++-- | Get the load average.  This assumes that you have a+--   utility called @\/usr\/bin\/uptime@ and that you have @sed@+--   installed; these are fairly common on GNU\/Linux systems but it+--   would be nice to make this more general.+loadAvg :: Logger+loadAvg = logCmd "/usr/bin/uptime | sed 's/.*: //; s/,//g'"++-- | Create a 'Logger' from an arbitrary shell command.+logCmd :: String -> Logger+logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c+                   fmap Just (hGetLine out) `catch` (const $ return Nothing)+                   -- no need to waitForProcess, we ignore SIGCHLD++-- | Get a count of filtered files in a directory.+-- See 'maildirUnread' and 'maildirNew' source for usage examples.+logFileCount :: FilePath          -- ^ directory in which to count files+             -> (String -> Bool)  -- ^ predicate to match if file should be counted+             -> Logger+logFileCount d p = do+    c <- liftIO ( getDirectoryContents d)+    let n = length $ Prelude.filter p c+    case n of+        0 -> return Nothing+        _ -> return $ Just $ show n++-- | Get a count of unread mails in a maildir. For maildir format+-- details, to write loggers for other classes of mail, see+-- <http://cr.yp.to/proto/maildir.html> and 'logFileCount'.+maildirUnread :: FilePath -> Logger+maildirUnread mdir = logFileCount (mdir ++ "/cur/") (isSuffixOf ",")++-- | Get a count of new mails in a maildir.+maildirNew :: FilePath -> Logger+maildirNew mdir = logFileCount (mdir ++ "/new/") (not . isPrefixOf ".")++-- $xmonad+--+-- A very small sample of what you can log since you have access to X. For+-- example you can loggerize the number of windows on each workspace, or+-- titles on other workspaces, or the id of the previously focused workspace....++-- | Get the title (name) of the focused window.+logTitle :: Logger+logTitle = withWindowSet $ traverse (fmap show . getName) . W.peek++-- | Get the name of the current layout.+logLayout :: Logger+logLayout = withWindowSet $ return . Just . ld+  where ld = description . W.layout . W.workspace . W.current++-- | Get the name of the current workspace.+logCurrent :: Logger+logCurrent = withWindowSet $ return . Just . W.currentTag++-- $format+-- Combine logger formatting functions to make your+-- 'XMonad.Hooks.DynamicLog.ppExtras' more colorful and readable.+-- (For convenience this module exports 'Control.Applicative.<$>' to+-- use instead of \'.\' or \'$\' in hard to read formatting lines.+-- For example:+--+-- > myLogHook = dynamicLogWithPP defaultPP {+-- >     -- skipped+-- >     , ppExtras = [lLoad, lTitle, logSp 3, wrapL "[" "]" $ date "%a %d %b"]+-- >     , ppOrder = \(ws,l,_,xs) -> [l,ws] ++ xs+-- >     }+-- >   where+-- >     -- lTitle = fixedWidthL AlignCenter "." 99 . dzenColorL "cornsilk3" "" . padL . shortenL 80 $ logTitle+-- >     -- or something like:+-- >     lTitle = fixedWidthL AlignCenter "." 99 <$> dzenColorL "cornsilk3" "" <$> padL . shortenL 80 $ logTitle+-- >+-- >     lLoad = dzenColorL "#6A5ACD" "" . wrapL loadIcon "   " . padL $ loadAvg+-- >     loadIcon = " ^i(/home/me/.dzen/icons/load.xbm)"+--+-- Note: When applying 'shortenL' or 'fixedWidthL' to logger strings+-- containing colors or other formatting commands, apply the formatting+-- /after/ the length adjustment, or include \"invisible\" characters+-- in the length specification, e.g. in the above \'^fg(cornsilk3)\' and+-- \'^fg()' yields 19 invisible and 80 visible characters.++-- | Use a string formatting function to edit a 'Logger' string.+-- For example, to create a tag function to prefix or label loggers,+-- as in \'tag: output\', use:+--+-- > tagL l = onLogger $ wrap (l ++ ": ") ""+-- >+-- >    tagL "bat" battery+-- >    tagL "load" loadAvg+--+-- If you already have a (String -> String) function you want to+-- apply to a logger:+--+-- > revL = onLogger trim+--+-- See formatting utility source code for more 'onLogger' usage examples.+onLogger :: (String -> String) -> Logger -> Logger+onLogger = fmap . fmap++-- | Wrap a logger's output in delimiters, unless it is @X (Nothing)@+-- or @X (Just \"\")@. Some examples:+--+-- >    wrapL " | " " | " (date "%a %d %b") -- ' | Tue 19 Feb | '+-- >+-- >    wrapL "bat: " "" battery            -- ' bat: battery_logger_output'+wrapL :: String -> String -> Logger -> Logger+wrapL l r = onLogger $ wrap l r++-- | Make a logger's output constant width by padding with the given string,+-- /even if the logger is/ @X (Nothing)@ /or/ @X (Just \"\")@. Useful to+-- reduce visual noise as a title logger shrinks and grows, to use a fixed+-- width for a logger that sometimes becomes Nothing, or even to create+-- fancy spacers or character based art effects.+--+-- It fills missing logger output with a repeated character like \".\",+-- \":\" or pattern, like \" -.-\". The cycling padding string is reversed on+-- the left of the logger output. This is mainly useful with AlignCenter.+fixedWidthL :: Align  -- ^ AlignCenter, AlignRight, or AlignLeft+            -> String -- ^ String to cycle to pad missing logger output+            -> Int    -- ^ Fixed length to output (including invisible formatting characters)+            -> Logger -> Logger+fixedWidthL a str n logger = do+    mbl <- logger+    let l = fromMaybe "" mbl+    case a of+       AlignCenter -> toL (take n $ padhalf l ++ l ++ cs)+       AlignRight -> toL (reverse (take n $ reverse l ++ cs))+       _ -> toL (take n $ l ++ cs)+  where+    toL = return . Just+    cs  = cycle str+    padhalf x = reverse $ take ((n - length x) `div` 2) cs++-- | Create a \"spacer\" logger, e.g. @logSp 3 -- loggerizes \'   \'@.+-- For more complex \"spacers\", use 'fixedWidthL' with @return Nothing@.+logSp :: Int -> Logger+logSp n = return . Just . take n $ cycle " "++-- | Pad a logger's output with a leading and trailing space, unless it+-- is @X (Nothing)@ or @X (Just \"\")@.+padL :: Logger -> Logger+padL = onLogger pad++-- | Limit a logger's length, adding \"...\" if truncated.+shortenL :: Int -> Logger -> Logger+shortenL = onLogger . shorten++-- | Color a logger's output with dzen foreground and background colors.+--+-- >  dzenColorL "green" "#2A4C3F" battery+dzenColorL :: String -> String -> Logger -> Logger+dzenColorL fg bg = onLogger $ dzenColor fg bg++-- | Color a logger's output with xmobar foreground and background colors.+--+-- >  xmobarColorL "#6A5ACD" "gray6" loadAverage+xmobarColorL :: String -> String -> Logger -> Logger+xmobarColorL fg bg = onLogger $ xmobarColor fg bg++-- todo+-- * dynamicLogXinerama logger? Or sorted onscreen Id's with "current" indicator?+-- is logCurrent really useful at all?+--+-- * ppVisible, etc. Resolve code dup. somehow. Refactor DynamicLog so can+-- be used for regular PP stuff /and/ loggers?+--+-- * fns for "ppExtras as a whole", combine loggers more nicely.+--+-- * parsers  to use with fixedWidthL to be smarter about invisible characters?
+ XMonad/Util/NamedScratchpad.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE PatternGuards #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.NamedScratchpad+-- Copyright   :  (c) Konstantin Sobolev <konstantin.sobolev@gmail.com>+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Konstantin Sobolev <konstantin.sobolev@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Named scratchpads that support several arbitrary applications at the same time.+--+-----------------------------------------------------------------------------++module XMonad.Util.NamedScratchpad (+  -- * Usage+  -- $usage+  NamedScratchpad(..),+  NamedScratchpads,+  namedScratchpadAction,+  namedScratchpadManageHook,+  namedScratchpadFilterOutWorkspace+  ) where++import XMonad+import XMonad.Core+import XMonad.ManageHook (composeAll,doFloat)+import XMonad.Hooks.ManageHelpers (doRectFloat)+import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)++import Control.Monad (filterM)+import Data.Maybe (maybe,listToMaybe)++import qualified XMonad.StackSet as W+++-- $usage+-- Allows to have several floating scratchpads running different applications.+-- Bind a key to 'namedScratchpadSpawnAction'.+-- Pressing it will spawn configured application, or bring it to the current+-- workspace if it already exists.+-- Pressing the key with the application on the current workspace will+-- send it to a hidden workspace called @NSP@.+--+-- If you already have a workspace called @NSP@, it will use that.+-- @NSP@ will also appear in xmobar and dzen status bars. You can tweak your+-- @dynamicLog@ settings to filter it out if you like.+--+-- Create named scratchpads configuration in your xmonad.hs like this:+--+-- > import XMonad.StackSet as W+-- > import XMonad.ManageHook+-- > import XMonad.Util.NamedScratchpad+-- >+-- > scratchpads = [+-- > -- run htop in xterm, find it by title, use default geometry+-- >     NS "htop" "xterm -e htop" (title =? "htop") Nothing ,+-- > -- run stardict, find it by class name, place the window+-- > -- 1/6 of screen width from the left, 1/6 of screen height+-- > -- from the top, 2/3 of screen width by 2/3 of screen height+-- >     NS "stardict" "stardict" (className =? "Stardict")+-- >         (Just $ W.RationalRect (1/6) (1/6) (2/3) (2/3))+-- > ]+--+-- Add keybindings:+--+-- >  , ((modMask x .|. controlMask .|. shiftMask, xK_t), namedScratchpadAction scratchpads "htop")+-- >  , ((modMask x .|. controlMask .|. shiftMask, xK_s), namedScratchpadAction scratchpads "stardict")+--+-- ... and a manage hook:+--+-- >  , manageHook = namedScratchpadManageHook scratchpads+--+-- For detailed instruction on editing the key binding see+-- "XMonad.Doc.Extending#Editing_key_bindings"+--++-- | Single named scratchpad configuration+data NamedScratchpad = NS { name  :: String               -- ^ Scratchpad name+                          , cmd   :: String               -- ^ Command used to run application+                          , query :: Query Bool           -- ^ Query to find already running application+                          , rect  :: Maybe W.RationalRect -- ^ Floating window geometry+                          }++-- | Named scratchpads configuration+type NamedScratchpads = [NamedScratchpad]++-- | Finds named scratchpad configuration by name+findByName :: NamedScratchpads -> String -> Maybe NamedScratchpad+findByName c s = listToMaybe $ filter ((s==).name) c++-- | Runs application which should appear in specified scratchpad+runApplication :: NamedScratchpad -> X ()+runApplication = spawn . cmd++-- | Action to pop up specified named scratchpad+namedScratchpadAction :: NamedScratchpads -- ^ Named scratchpads configuration+                      -> String           -- ^ Scratchpad name+                      -> X ()+namedScratchpadAction confs n+    | Just conf <- findByName confs n = withWindowSet $ \s -> do+        -- try to find it on the current workspace+        filterCurrent <- filterM (runQuery (query conf))+                            ( (maybe [] W.integrate . W.stack .+                                    W.workspace . W.current) s)+        case filterCurrent of+            (x:_) -> do+                -- create hidden workspace if it doesn't exist+                if null (filter ((== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))+                    then addHiddenWorkspace scratchpadWorkspaceTag+                    else return ()+                -- push window there+                windows $ W.shiftWin scratchpadWorkspaceTag x+            [] -> do+                -- try to find it on all workspaces+                filterAll <- filterM (runQuery (query conf)) (W.allWindows s)+                case filterAll of+                    (x:_) -> windows $ W.shiftWin (W.currentTag s) x+                    []    -> runApplication conf++    | otherwise = return ()++-- tag of the scratchpad workspace+scratchpadWorkspaceTag :: String+scratchpadWorkspaceTag = "NSP"++-- | Manage hook to use with named scratchpads+namedScratchpadManageHook :: NamedScratchpads -- ^ Named scratchpads configuration+                          -> ManageHook+namedScratchpadManageHook = composeAll . fmap (\c -> query c --> maybe doFloat doRectFloat (rect c))++-- | Transforms a workspace list containing the NSP workspace into one that+-- doesn't contain it. Intended for use with logHooks.+namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]+namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag)++-- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
+ XMonad/Util/NamedWindows.hs view
@@ -0,0 +1,64 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.NamedWindows+-- Copyright   :  (c) David Roundy <droundy@darcs.net>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  none+-- 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 Prelude hiding ( catch )+import Control.Applicative ( (<$>) )+import Control.Exception ( bracket, catch )+import Data.Maybe ( fromMaybe, listToMaybe )++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 = withDisplay $ \d -> do+    -- TODO, this code is ugly and convoluted -- clean it up+    let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy)++        getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)+                      `catch` \_ -> getTextProperty d w wM_NAME++        copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop++    io $ getIt `catch` \_ ->  ((`NW` w) . resName) `fmap` getClassHint d 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/Paste.hs view
@@ -0,0 +1,94 @@+{- |+Module      :  XMonad.Util.Paste+Copyright   :  (C) 2008 Jérémy Bobbio, gwern+License     :  BSD3++Maintainer  :  gwern <gwern0@gmail.com>+Stability   :  unstable+Portability :  unportable++A module for sending key presses to windows. This modules provides generalized+and specialized functions for this task.+-}++module XMonad.Util.Paste ( -- * Usage+                           -- $usage+                           pasteSelection,+                           pasteString,+                           pasteChar,+                           sendKey,+                           sendKeyWindow,+                           noModMask+                         )+                           where++import XMonad (io, theRoot, withDisplay, X ())+import Graphics.X11+import Graphics.X11.Xlib.Extras (none, setEventType, setKeyEvent)+import Control.Monad.Reader (asks)+import XMonad.Operations (withFocused)+import Data.Char (isUpper)+import Graphics.X11.Xlib.Misc (stringToKeysym)+import XMonad.Util.XSelection (getSelection)++{- $usage++Import this module into your xmonad.hs as usual:++> import XMonad.Util.Paste++And use the functions. They all return 'X' (), and so are appropriate+for use as keybindings. Example:++>          , ((m,              xK_d), pasteString "foo bar") ]++Don't expect too much of the functions; they probably don't work on complex+texts.+-}++-- | Paste the current X mouse selection. Note that this uses 'getSelection' from+--   "XMonad.Util.XSelection" and so is heir to its flaws.+pasteSelection :: X ()+pasteSelection = getSelection >>= pasteString++-- | Send a string to the window which is currently focused. This function correctly+-- handles capitalization.+pasteString :: String -> X ()+pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar noModMask x)++{- | Send a character to the current window. This is more low-level.+   Remember that you must handle the case of capitalization appropriately.+   That is, from the window's perspective:++   > pasteChar mod2Mask 'F' ~> "f"++   You would want to do something like:++   > pasteChar shiftMask 'F'++   Note that this function makes use of 'stringToKeysym', and so will probably+   have trouble with any 'Char' outside ASCII.+-}+pasteChar :: KeyMask -> Char -> X ()+pasteChar m c = sendKey m $ stringToKeysym [c]++sendKey :: KeyMask -> KeySym -> X ()+sendKey = (withFocused .) . sendKeyWindow++-- | The primitive. Allows you to send any combination of 'KeyMask' and 'KeySym' to any 'Window' you specify.+sendKeyWindow :: KeyMask -> KeySym -> Window -> X ()+sendKeyWindow mods key w = withDisplay $ \d -> do+              rootw <- asks theRoot+              keycode <- io $ keysymToKeycode d key+              io $ allocaXEvent $ \ev -> do+                  setEventType ev keyPress+                  setKeyEvent ev w rootw none mods keycode True+                  sendEvent d w True keyPressMask ev+                  setEventType ev keyRelease+                  sendEvent d w True keyReleaseMask ev++-- | A null 'KeyMask'. Used when you don't want a character or string shifted, control'd, or what.+--+--   TODO: This really should be a function in the X11 binding. When noModMask shows up there, remove.+noModMask :: KeyMask+noModMask = 0
+ XMonad/Util/Run.hs view
@@ -0,0 +1,137 @@+-----------------------------------------------------------------------------+-- |+-- 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,++                          hPutStr, hPutStrLn  -- re-export for convenience+                         ) where++import System.Posix.IO+import System.Posix.Process (executeFile, forkProcess, createSession)+import Control.Concurrent (threadDelay)+import Control.Exception (try) -- use OldException with base 4+import System.IO+import System.Process (runInteractiveProcess)+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"++-- | Return output if the command succeeded, otherwise return @()@.+-- 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, _) <- runInteractiveProcess cmd args Nothing Nothing+    hPutStr pin input+    hClose pin+    output <- hGetContents pout+    when (output == output) $ return ()+    hClose pout+    hClose perr+    -- no need to waitForProcess, we ignore SIGCHLD+    return output++-- | Wait is in µs (microseconds)+runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()+runProcessWithInputAndWait cmd args input timeout = do+    forkProcess $ do+        (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing+        hPutStr pin input+        hFlush pin+        threadDelay timeout+        hClose pin+        hClose pout+        hClose perr+        -- no need to waitForProcess, we ignore SIGCHLD+        return ()+    return ()++-- | Multiplies by ONE MILLION, for functions that take microseconds.+--+-- Use like:+--+-- > (5.5 `seconds`)+seconds :: Rational -> Int+seconds = fromEnum . (* 1000000)++{- | 'safeSpawn' bypasses "XMonad.Core"'s 'spawn' command, because spawn passes+strings to \/bin\/sh to be interpreted as shell commands. This is+often what one wants, but in many cases the passed string will contain+shell metacharacters which one does not want interpreted as such (URLs+particularly often have shell metacharacters like \'&\' in them). In+this case, it is more useful to specify a file or program to be run+and a string to give it as an argument so as to bypass the shell and+be certain the program will receive the string as you typed it.+unsafeSpawn is internally an alias for XMonad's 'spawn', to remind one that use+of it can be, well, unsafe.+Examples:++> , ((modMask, xK_Print), unsafeSpawn "import -window root $HOME/xwd-$(date +%s)$$.png")+> , ((modMask, xK_d    ), safeSpawn "firefox" "")++Note that the unsafeSpawn example must be unsafe and not safe because+it makes use of shell interpretation by relying on @$HOME@ and+interpolation, whereas the safeSpawn example can be safe because+Firefox doesn't need any arguments if it is just being started. -}+safeSpawn :: MonadIO m => FilePath -> String -> m ()+safeSpawn prog arg = liftIO (try (forkProcess $ executeFile prog True [arg] Nothing) >> return ())++unsafeSpawn :: MonadIO m => String -> m ()+unsafeSpawn = spawn++-- | Open a terminal emulator. The terminal emulator is specified in @defaultConfig@ as xterm by default. It is then+-- asked to pass the shell a command with certain options. This is unsafe in the sense of 'unsafeSpawn'+unsafeRunInTerm, runInTerm :: String -> String -> X ()+unsafeRunInTerm options command = asks (terminal . config) >>= \t -> unsafeSpawn $ t ++ " " ++ options ++ " -e " ++ command+runInTerm = unsafeRunInTerm++-- | Run a given program in the preferred terminal emulator; see 'runInTerm'. This makes use of 'safeSpawn'.+safeRunInTerm :: String -> String -> X ()+safeRunInTerm options command = asks (terminal . config) >>= \t -> safeSpawn t (options ++ " -e " ++ command)++-- | Launch an external application through the system shell and return a @Handle@ to its standard input.+spawnPipe :: String -> IO Handle+spawnPipe x = do+    (rd, wr) <- createPipe+    setFdOption wr CloseOnExec True+    h <- fdToHandle wr+    hSetBuffering h LineBuffering+    forkProcess $ do+        createSession+        uninstallSignalHandlers+        dupTo rd stdInput+        executeFile "/bin/sh" False ["-c", x] Nothing+    return h
+ XMonad/Util/Scratchpad.hs view
@@ -0,0 +1,155 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Scratchpad+-- Copyright   :  (c) Braden Shepherdson 2008+-- License     :  BSD-style (as xmonad)+--+-- Maintainer  :  Braden.Shepherdson@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Very handy hotkey-launched floating terminal window.+--+-----------------------------------------------------------------------------++module XMonad.Util.Scratchpad (+  -- * Usage+  -- $usage+  scratchpadSpawnAction+  ,scratchpadSpawnActionTerminal+  ,scratchpadSpawnActionCustom+  ,scratchpadManageHookDefault+  ,scratchpadManageHook+  ,scratchpadFilterOutWorkspace+  ) where++import XMonad+import XMonad.Core+import XMonad.Hooks.ManageHelpers (doRectFloat)+import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)++import Control.Monad (filterM)++import qualified XMonad.StackSet as W+++-- $usage+-- Bind a key to 'scratchpadSpawnAction'+-- Pressing it will spawn the terminal, or bring it to the current+-- workspace if it already exists.+-- Pressing the key with the terminal on the current workspace will+-- send it to a hidden workspace called @SP@.+--+-- If you already have a workspace called @SP@, it will use that.+-- @SP@ will also appear in xmobar and dzen status bars. You can tweak your+-- @dynamicLog@ settings to filter it out if you like.+--+-- A tool like detach (<http://detach.sourceforge.net>) turns it+-- into a launchpad for X apps.+--+-- By default, your xmonad terminal is used.+-- The default ManageHook uses a centered, half-screen-wide,+-- quarter-screen-tall window.+-- The key, position and size are configurable.+--+-- The terminal application must support the @-name@ argument.+-- Known supported terminals: rxvt, rxvt-unicode, xterm.+-- Most others are likely to follow the lead set by xterm.+--+-- Bind the following to a key in your xmonad.hs keybindings:+--+-- > scratchpadSpawnAction conf+--+-- Where @conf@ is the configuration.+--+-- And add one of the @scratchpadManageHook*@s to your ManageHook list.+-- The default rectangle is half the screen wide and a quarter of the+-- screen tall, centered.+--++++-- | Action to pop up the terminal, for the user to bind to a custom key.+scratchpadSpawnAction :: XConfig l -- ^ The configuration, to retrieve the terminal+                      -> X ()+scratchpadSpawnAction conf =+    scratchpadAction $ spawn $ terminal conf ++ " -name scratchpad"+++-- | Action to pop up the terminal, with a directly specified terminal.+scratchpadSpawnActionTerminal :: String -- ^ Name of the terminal program+                                 -> X ()+scratchpadSpawnActionTerminal term =+    scratchpadAction $ spawn $ term ++ " -name scratchpad"+++-- | Action to pop up any program with the user specifiying how to set+--   its resource to \"scratchpad\". For example, with gnome-terminal+--   bind the following to a key:+--+--   > scratchpadSpawnActionCustom "gnome-terminal --name scratchpad"+scratchpadSpawnActionCustom :: String -- ^ Command to spawn a program with resource \"scratchpad\"+                                 -> X ()+scratchpadSpawnActionCustom = scratchpadAction . spawn++-- The heart of the new summon/banish terminal.+-- The logic is thus:+-- 1. if the scratchpad is on the current workspace, send it to the hidden one.+--    - if the scratchpad workspace doesn't exist yet, create it first.+-- 2. if the scratchpad is elsewhere, bring it here.+scratchpadAction :: X () -> X ()+scratchpadAction action = withWindowSet $ \s -> do+  filterCurrent <- filterM (runQuery scratchpadQuery)+                     ( (maybe [] W.integrate+                        . W.stack+                        . W.workspace+                        . W.current) s)+  case filterCurrent of+    (x:_) -> do+      if null (filter ( (== scratchpadWorkspaceTag) . W.tag) (W.workspaces s))+         then addHiddenWorkspace scratchpadWorkspaceTag+         else return ()+      windows (W.shiftWin scratchpadWorkspaceTag x)+    []    -> do+      filterAll <- filterM (runQuery scratchpadQuery) (W.allWindows s)+      case filterAll of+        (x:_) -> windows (W.shiftWin (W.currentTag s) x)+        []    -> action -- run the provided action to spawn it.+++-- factored out since it appears in several places+scratchpadWorkspaceTag :: String+scratchpadWorkspaceTag = "SP"++-- factored out since this is common to both the ManageHook and the action+scratchpadQuery :: Query Bool+scratchpadQuery = resource =? "scratchpad"+++-- | The ManageHook, with the default rectangle:+-- Half the screen wide, a quarter of the screen tall, centered.+scratchpadManageHookDefault :: ManageHook+scratchpadManageHookDefault = scratchpadManageHook scratchpadDefaultRect+++-- | The ManageHook, with a user-specified StackSet.RationalRect,+--   e.g., for a terminal 4/10 of the screen width from the left, half+--   the screen height from the top, and 6/10 of the screen width by+--   3/10 the screen height, use:+--+-- > scratchpadManageHook (W.RationalRect 0.4 0.5 0.6 0.3)+scratchpadManageHook :: W.RationalRect -- ^ User-specified screen rectangle.+                     -> ManageHook+scratchpadManageHook rect = scratchpadQuery --> doRectFloat rect+++-- | Transforms a workspace list containing the SP workspace into one that+-- doesn't contain it. Intended for use with logHooks.+scratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace]+scratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag)+++scratchpadDefaultRect :: W.RationalRect+scratchpadDefaultRect = W.RationalRect 0.25 0.375 0.5 0.25++
+ XMonad/Util/Themes.hs view
@@ -0,0 +1,340 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Themes+-- Copyright   :  (C) 2007 Andrea Rossato+-- License     :  BSD3+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A (hopefully) growing collection of themes for decorated layouts.+--+-----------------------------------------------------------------------------++module XMonad.Util.Themes+    ( -- * Usage+      -- $usage+      listOfThemes+    , ppThemeInfo+    , xmonadTheme+    , smallClean+    , robertTheme+    , deiflTheme+    , oxymor00nTheme+    , donaldTheme+    , wfarrTheme+    , kavonForestTheme+    , kavonLakeTheme+    , kavonPeacockTheme+    , kavonVioGreenTheme+    , kavonBluesTheme+    , kavonAutumnTheme+    , kavonFireTheme+    , kavonChristmasTheme+    , ThemeInfo (..)+    ) where++import XMonad.Layout.Decoration++-- $usage+-- This module stores some user contributed themes which can be used+-- with decorated layouts (such as Tabbed).  (Note that these themes+-- only apply to decorated layouts, such as those found in+-- "XMonad.Layout.Tabbed" and "XMonad.Layout.DecorationMadness"; they+-- do not apply to xmonad as a whole.)+--+-- If you want to use one of them with one of your decorated layouts,+-- you need to substitute defaultTheme with, for instance, (theme+-- smallClean).+--+-- Here is an example:+--+-- > import XMonad+-- > import XMonad.Util.Themes+-- > import XMonad.Layout.Tabbed+-- >+-- > myLayout = tabbed shrinkText (theme smallClean)+-- >+-- > main = xmonad defaultConfig {layoutHook = myLayout}+--+-- If you have a theme you would like to share, adding it to this+-- module is very easy.+--+-- You can use 'xmonadTheme' or 'smallClean' as a template.+--+-- At the present time only the 'themeName' field is used. But please+-- provide all the other information, which will be used at a later+-- time.+--+-- Please, remember to add your theme to the list of exported+-- functions, and to the 'listOfThemes'.+--+-- Thanks for your contribution!++data ThemeInfo =+    TI { themeName        :: String+       , themeAuthor      :: String+       , themeDescription :: String+       , theme            :: Theme+       }++newTheme :: ThemeInfo+newTheme = TI "" "" "" defaultTheme++ppThemeInfo :: ThemeInfo -> String+ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t+    where "" <> x = x+          x <> y = x ++ " - " ++ y+++listOfThemes :: [ThemeInfo]+listOfThemes = [ xmonadTheme+               , smallClean+               , deiflTheme+               , oxymor00nTheme+               , robertTheme+               , donaldTheme+               , wfarrTheme+	       , kavonForestTheme+	       , kavonLakeTheme+	       , kavonPeacockTheme+	       , kavonVioGreenTheme+	       , kavonBluesTheme+	       , kavonAutumnTheme+	       , kavonFireTheme+	       , kavonChristmasTheme+               ]++-- | The default xmonad theme, by David Roundy.+xmonadTheme :: ThemeInfo+xmonadTheme =+    newTheme { themeName        = "xmonadTheme"+             , themeAuthor      = "David Roundy"+             , themeDescription = "The default xmonad theme"+             , theme            = defaultTheme+             }++-- | Small decorations with a Ion3 remembrance, by Andrea Rossato.+smallClean :: ThemeInfo+smallClean =+    newTheme { themeName        = "smallClean"+             , themeAuthor      = "Andrea Rossato"+             , themeDescription = "Small decorations with a Ion3 remembrance"+             , theme            = defaultTheme { activeColor         = "#8a999e"+                                               , inactiveColor       = "#545d75"+                                               , activeBorderColor   = "white"+                                               , inactiveBorderColor = "grey"+                                               , activeTextColor     = "white"+                                               , inactiveTextColor   = "grey"+                                               , decoHeight          = 14+                                               }+             }++-- | Don's prefered colors - from DynamicLog...;)+donaldTheme  :: ThemeInfo+donaldTheme =+    newTheme { themeName        = "donaldTheme"+             , themeAuthor      = "Andrea Rossato"+             , themeDescription = "Don's prefered colors - from DynamicLog...;)"+             , theme            = defaultTheme { activeColor         = "#2b4f98"+                                               , inactiveColor       = "#cccccc"+                                               , activeBorderColor   = "#2b4f98"+                                               , inactiveBorderColor = "#cccccc"+                                               , activeTextColor     = "white"+                                               , inactiveTextColor   = "black"+                                               , decoHeight          = 16+                                               }+             }++-- | Ffrom Robert Manea's prompt theme.+robertTheme  :: ThemeInfo+robertTheme =+    newTheme { themeName        = "robertTheme"+             , themeAuthor      = "Andrea Rossato"+             , themeDescription = "From Robert Manea's prompt theme"+             , theme            = defaultTheme { activeColor         = "#aecf96"+                                               , inactiveColor       = "#111111"+                                               , activeBorderColor   = "#aecf96"+                                               , inactiveBorderColor = "#111111"+                                               , activeTextColor     = "black"+                                               , inactiveTextColor   = "#d5d3a7"+                                               , fontName            = "-*-profont-*-*-*-*-11-*-*-*-*-*-iso8859"+                                               , decoHeight          = 16+                                               }+             }++-- | deifl\'s Theme, by deifl.+deiflTheme :: ThemeInfo+deiflTheme =+    newTheme { themeName        = "deiflTheme"+             , themeAuthor      = "deifl"+             , themeDescription = "deifl's Theme"+             , theme            = defaultTheme { inactiveBorderColor = "#708090"+                                               , activeBorderColor   = "#5f9ea0"+                                               , activeColor         = "#000000"+                                               , inactiveColor       = "#333333"+                                               , inactiveTextColor   = "#888888"+                                               , activeTextColor     = "#87cefa"+                                               , fontName            = "-xos4-terminus-*-*-*-*-12-*-*-*-*-*-*-*"+                                               , decoHeight          = 15+                                               }+             }++-- | oxymor00n\'s theme, by Tom Rauchenwald.+oxymor00nTheme :: ThemeInfo+oxymor00nTheme =+    newTheme { themeName        = "oxymor00nTheme"+             , themeAuthor      = "Tom Rauchenwald"+             , themeDescription = "oxymor00n's theme"+             , theme            = defaultTheme { inactiveBorderColor = "#000"+                                               , activeBorderColor = "aquamarine3"+                                               , activeColor = "aquamarine3"+                                               , inactiveColor = "DarkSlateGray4"+                                               , inactiveTextColor = "#222"+                                               , activeTextColor = "#222"+                                               -- This font can be found in the package ttf-alee+                                               -- on debian-systems+                                               , fontName = "-*-Bandal-*-*-*-*-12-*-*-*-*-*-*-*"+                                               , decoHeight = 15+                                               , urgentColor = "#000"+                                               , urgentTextColor = "#63b8ff"+                                               }+             }++wfarrTheme :: ThemeInfo+wfarrTheme =+    newTheme { themeName        = "wfarrTheme"+             , themeAuthor      = "Will Farrington"+             , themeDescription = "A nice blue/black theme."+             , theme            = defaultTheme { activeColor         = "#4c7899"+                                               , inactiveColor       = "#333333"+                                               , activeBorderColor   = "#285577"+                                               , inactiveBorderColor = "#222222"+                                               , activeTextColor     = "#ffffff"+                                               , inactiveTextColor   = "#888888"+                                               , fontName            = "-*-fixed-medium-r-*--10-*-*-*-*-*-iso8859-1"+                                               , decoHeight          = 12+                                               }+             }++-- | Forest colours, by Kathryn Andersen+kavonForestTheme :: ThemeInfo+kavonForestTheme =+    newTheme { themeName        = "kavonForestTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Forest colours"+             , theme            = defaultTheme { activeColor         = "#115422"+                                               , activeBorderColor   = "#1a8033"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#543211"+                                               , inactiveBorderColor = "#804c19"+                                               , inactiveTextColor   = "#ffcc33"+                                               }+             }++-- | Lake (blue/green) colours, by Kathryn Andersen+kavonLakeTheme :: ThemeInfo+kavonLakeTheme =+    newTheme { themeName        = "kavonLakeTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Lake (blue/green) colours"+             , theme            = defaultTheme { activeColor         = "#001166"+                                               , activeBorderColor   = "#1f3999"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#09592a"+                                               , inactiveBorderColor = "#198044"+                                               , inactiveTextColor   = "#73e6a3"+                                               }+             }++-- | Peacock colours, by Kathryn Andersen+kavonPeacockTheme :: ThemeInfo+kavonPeacockTheme =+    newTheme { themeName        = "kavonPeacockTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Peacock colours"+             , theme            = defaultTheme { activeColor         = "#190f4c"+                                               , activeBorderColor   = "#2b1980"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#225173"+                                               , inactiveBorderColor = "#2a638c"+                                               , inactiveTextColor   = "#8fb2cc"+                                               }+             }++-- | Violet-Green colours, by Kathryn Andersen+kavonVioGreenTheme :: ThemeInfo+kavonVioGreenTheme =+    newTheme { themeName        = "kavonVioGreenTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Violet-Green colours"+             , theme            = defaultTheme { activeColor         = "#37174c"+                                               , activeBorderColor   = "#333399"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#174c17"+                                               , inactiveBorderColor = "#336633"+                                               , inactiveTextColor   = "#aaccaa"+                                               }+             }++-- | Blue colours, by Kathryn Andersen+kavonBluesTheme :: ThemeInfo+kavonBluesTheme =+    newTheme { themeName        = "kavonBluesTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Blue colours"+             , theme            = defaultTheme { activeColor         = "#000066"+                                               , activeBorderColor   = "#111199"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#9999ee"+                                               , inactiveBorderColor = "#6666cc"+                                               , inactiveTextColor   = "black"+                                               }+             }++-- | Christmas colours, by Kathryn Andersen+kavonChristmasTheme :: ThemeInfo+kavonChristmasTheme =+    newTheme { themeName        = "kavonChristmasTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Christmas (green + red) colours"+             , theme            = defaultTheme { activeColor         = "#660000"+                                               , activeBorderColor   = "#990000"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#006600"+                                               , inactiveBorderColor = "#003300"+                                               , inactiveTextColor   = "#99bb99"+                                               }+             }++-- | Autumn colours, by Kathryn Andersen+kavonAutumnTheme :: ThemeInfo+kavonAutumnTheme =+    newTheme { themeName        = "kavonAutumnTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Autumn (brown + red) colours"+             , theme            = defaultTheme { activeColor         = "#660000"+                                               , activeBorderColor   = "#990000"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#542d11"+                                               , inactiveBorderColor = "#804d1A"+                                               , inactiveTextColor   = "#ffcc33"+                                               }+             }++-- | Fire colours, by Kathryn Andersen+kavonFireTheme :: ThemeInfo+kavonFireTheme =+    newTheme { themeName        = "kavonFireTheme"+             , themeAuthor      = "Kathryn Andersen"+             , themeDescription = "Fire (orange + red) colours"+             , theme            = defaultTheme { activeColor         = "#660000"+                                               , activeBorderColor   = "#990000"+                                               , activeTextColor     = "white"+                                               , inactiveColor       = "#ff8000"+                                               , inactiveBorderColor = "#d9b162"+                                               , inactiveTextColor   = "black"+                                               }+             }+
+ XMonad/Util/Timer.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.Timer+-- Copyright   :  (c) Andrea Rossato and David Roundy 2007+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  andrea.rossato@unibz.it+-- Stability   :  unstable+-- Portability :  unportable+--+-- A module for setting up timers+-----------------------------------------------------------------------------++module XMonad.Util.Timer+    ( -- * Usage+      -- $usage+      startTimer+    , handleTimer+    , TimerId+    ) where++import XMonad+import Control.Applicative+import Control.Concurrent+import Data.Unique+import System.Posix.Process (forkProcess)++-- $usage+-- This module can be used to setup a timer to handle deferred events.+-- See 'XMonad.Layout.ShowWName' for an usage example.++type TimerId = Int++-- | Start a timer, which will send a ClientMessageEvent after some+-- time (in seconds).+startTimer :: Rational -> X TimerId+startTimer s = io $ do+  u   <- hashUnique <$> newUnique+  forkProcess $ do+    d   <- openDisplay ""+    rw  <- rootWindow d $ defaultScreen d+    threadDelay (fromEnum $ s * 1000000)+    a <- internAtom d "XMONAD_TIMER" False+    allocaXEvent $ \e -> do+         setEventType e clientMessage+         setClientMessageEvent e rw a 32 (fromIntegral u) currentTime+         sendEvent d rw False structureNotifyMask e+    sync d False+  return u++-- | Given a 'TimerId' and an 'Event', run an action when the 'Event'+-- has been sent by the timer specified by the 'TimerId'+handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)+handleTimer ti (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) action = do+  d <- asks display+  a <- io $ internAtom d "XMONAD_TIMER" False+  if mt == a && dt /= [] && fromIntegral (head dt) == ti+     then action+     else return Nothing+handleTimer _ _ _ = return Nothing
+ XMonad/Util/WindowProperties.hs view
@@ -0,0 +1,95 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.WindowProperties+-- Copyright   :  (c) Roman Cheplyaka+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>+-- Stability   :  unstable+-- Portability :  unportable+--+-- EDSL for specifying window properties; various utilities related to window+-- properties.+--+-----------------------------------------------------------------------------+module XMonad.Util.WindowProperties (+    -- * EDSL for window properties+    -- $edsl+    Property(..), hasProperty, focusedHasProperty, allWithProperty,+    propertyToQuery,+    -- * Helper functions+    -- $helpers+    getProp32, getProp32s)+where+import XMonad+import qualified XMonad.StackSet as W+import Foreign.C.Types (CLong)+import Control.Monad++-- $edsl+-- Allows to specify window properties, such as title, classname or+-- resource, and to check them.+--+-- In contrast to ManageHook properties, these are instances of Show and Read,+-- so they can be used in layout definitions etc. For example usage see "XMonad.Layout.IM"++-- | Most of the property constructors are quite self-explaining.+data Property = Title String+              | ClassName String+              | Resource String+              | Role String -- ^ WM_WINDOW_ROLE property+              | And Property Property  +              | Or  Property Property+              | Not Property+              | Const Bool+              deriving (Read, Show)+infixr 9 `And`+infixr 8 `Or`++-- | Does given window have this property?+hasProperty :: Property -> Window -> X Bool+hasProperty (Title s)     w = withDisplay $ \d -> fmap (Just s ==) $ io $ fetchName d w+hasProperty (Resource s)  w = withDisplay $ \d -> fmap ((==) s . resName ) $ io $ getClassHint d w+hasProperty (ClassName s) w = withDisplay $ \d -> fmap ((==) s . resClass) $ io $ getClassHint d w+hasProperty (Role s) w = withDisplay $ \d -> fmap ((==) (Just s)) $ getStringProperty d w "WM_WINDOW_ROLE"+hasProperty (And p1 p2)   w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 && r2 }+hasProperty (Or p1 p2)    w = do { r1 <- hasProperty p1 w; r2 <- hasProperty p2 w; return $ r1 || r2 }+hasProperty (Not p1)      w = do { r1 <- hasProperty p1 w; return $ not r1 }+hasProperty (Const b)     _ = return b++-- | Does the focused window have this property?+focusedHasProperty :: Property -> X Bool+focusedHasProperty p = do+    ws <- gets windowset+    let ms = W.stack $ W.workspace $ W.current ws+    case ms of+        Just s  -> hasProperty p $ W.focus s+        Nothing -> return False++-- | Find all existing windows with specified property+allWithProperty :: Property -> X [Window]+allWithProperty prop = withDisplay $ \dpy -> do+    rootw <- asks theRoot+    (_,_,wins) <- io $ queryTree dpy rootw+    hasProperty prop `filterM` wins++-- | Convert property to 'Query' 'Bool' (see "XMonad.ManageHook")+propertyToQuery :: Property -> Query Bool+propertyToQuery (Title s) = title =? s+propertyToQuery (Resource s) = resource =? s+propertyToQuery (ClassName s) = className =? s+propertyToQuery (Role s) = stringProperty "WM_WINDOW_ROLE" =? s+propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2+propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2+propertyToQuery (Not p) = not `fmap` propertyToQuery p+propertyToQuery (Const b) = return b++-- $helpers++-- | Get a window property from atom+getProp32 :: Atom -> Window -> X (Maybe [CLong])+getProp32 a w = withDisplay $ \dpy -> io $ getWindowProperty32 dpy a w++-- | Get a window property from string+getProp32s :: String -> Window -> X (Maybe [CLong])+getProp32s str w = do { a <- getAtom str; getProp32 a w }
+ XMonad/Util/WorkspaceCompare.hs view
@@ -0,0 +1,94 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.WorkspaceCompare+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--++module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort+                                    , getWsIndex+                                    , getWsCompare+                                    , getWsCompareByTag+                                    , getXineramaWsCompare+                                    , mkWsSort+                                    , getSortByIndex+                                    , getSortByTag+                                    , getSortByXineramaRule ) where++import XMonad+import qualified XMonad.StackSet as S+import Data.List+import Data.Monoid+import Data.Ord+import Data.Maybe++type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering+type WorkspaceSort = [WindowSpace] -> [WindowSpace]++-- | Lookup the index of a workspace id in the user's config, return Nothing+-- if that workspace does not exist in the config.+getWsIndex :: X (WorkspaceId -> Maybe Int)+getWsIndex = do+    spaces <- asks (workspaces . config)+    return $ flip elemIndex spaces++-- | A comparison function for WorkspaceId, based on the index of the+--   tags in the user's config.+getWsCompare :: X WorkspaceCompare+getWsCompare = do+    wsIndex <- getWsIndex+    return $ \a b -> f (wsIndex a) (wsIndex b) `mappend` compare a b+  where+    f Nothing Nothing   = EQ+    f (Just _) Nothing  = LT+    f Nothing (Just _)  = GT+    f (Just x) (Just y) = compare x y++-- | A simple comparison function that orders workspaces+--   lexicographically by tag.+getWsCompareByTag :: X WorkspaceCompare+getWsCompareByTag = return compare++-- | A comparison function for Xinerama based on visibility, workspace+--   and screen id. It produces the same ordering as+--   'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'.+getXineramaWsCompare :: X WorkspaceCompare+getXineramaWsCompare = do+    w <- gets windowset+    return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of+        (True, True)   -> comparing (tagToSid (onScreen w)) a b+        (False, False) -> compare a b+        (True, False)  -> LT+        (False, True)  -> GT+  where+    onScreen w =  S.current w : S.visible w+    isOnScreen a w  = a `elem` map (S.tag . S.workspace) (onScreen w)+    tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s++-- | Create a workspace sorting function from a workspace comparison+--   function.+mkWsSort :: X WorkspaceCompare -> X WorkspaceSort+mkWsSort cmpX = do+  cmp <- cmpX+  return $ sortBy (\a b -> cmp (S.tag a) (S.tag b))++-- | Sort several workspaces according to their tags' indices in the+--   user's config.+getSortByIndex :: X WorkspaceSort+getSortByIndex = mkWsSort getWsCompare++-- | Sort workspaces lexicographically by tag.+getSortByTag :: X WorkspaceSort+getSortByTag = mkWsSort getWsCompareByTag++-- | Sort serveral workspaces for xinerama displays, in the same order+--   produced by 'XMonad.Hooks.DynamicLog.pprWindowSetXinerama': first+--   visible workspaces, sorted by screen, then hidden workspaces,+--   sorted by tag.+getSortByXineramaRule :: X WorkspaceSort+getSortByXineramaRule = mkWsSort getXineramaWsCompare+
+ XMonad/Util/XSelection.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE CPP #-}+{- |+Module      :  XMonad.Util.XSelection+Copyright   :  (C) 2007 Andrea Rossato, Matthew Sackman+License     :  BSD3++Maintainer  : Gwern Branwen <gwern0@gmail.com>+Stability   :  unstable+Portability :  unportable++A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).+'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils, available:++> $ darcs get <http://gorgias.mine.nu/repos/xmonad-utils>+-}++module XMonad.Util.XSelection (  -- * Usage+                                 -- $usage+                                 getSelection,+                                 promptSelection,+                                 safePromptSelection,+                                 transformPromptSelection,+                                 transformSafePromptSelection,+                                 putSelection) where++import Control.Concurrent (forkIO)+import Control.Exception as E (catch)+import Control.Monad(Monad (return, (>>)), Functor(..), liftM, join)+import Data.Char (ord)+import Data.Maybe (fromMaybe)+import XMonad+import XMonad.Util.Run (safeSpawn, unsafeSpawn)++#ifdef USE_UTF8+import Codec.Binary.UTF8.String (decode)+#else+import Data.Bits (shiftL, (.&.), (.|.))+import Data.Char (chr)+import Data.Word (Word8)+{- | 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/>+   (as of version 0.1),\which is BSD-3 licensed like this module.+   It'd be better to just @import Codec.Binary.UTF8.String (decode)@, but then users of this would need to install it; XMonad has enough+   dependencies already. -}+decode :: [Word8] -> String+decode [] = ""+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+#endif++{- $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 (perhaps+   the selection string is an URL you just highlighted), then one could add+   to the xmonad.hs a line like thus:++   > , ((modMask .|. shiftMask, xK_b), promptSelection "firefox")++   There are a number of known problems with XSelection:++    * Unicode handling is busted. But it's still better than calling+      'chr' to translate to ASCII, at least.+      As near as I can tell, the mangling happens when the String is+      outputted somewhere, such as via promptSelection's passing through+      the shell, or GHCi printing to the terminal. utf-string has IO functions+      which can fix this, though I do not know have to use them here. It's+      a complex issue; see+      <http://www.haskell.org/pipermail/xmonad/2007-September/001967.html>+      and <http://www.haskell.org/pipermail/xmonad/2007-September/001966.html>.++    * Needs more elaborate functionality: Emacs' registers are nice; if you+      don't know what they are, see <http://www.gnu.org/software/emacs/manual/html_node/emacs/Registers.html#Registers> -}++-- | Returns a String corresponding to the current mouse selection in X; if there is none, an empty string is returned. Note that this is+-- really only reliable for ASCII text and currently escapes or otherwise mangles more complex UTF-8 characters.+getSelection :: MonadIO m => m String+getSelection = io $ 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 specified string.+putSelection :: MonadIO m => String -> m ()+putSelection text = io $ 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 system shell, \/bin\/sh; if you do not wish your selected text+to be interpreted or mangled by the shell, use 'safePromptSelection'. safePromptSelection will bypass the+shell using 'safeSpawn' from "XMonad.Util.Run"; see its documentation for more+details on the advantages and disadvantages of using safeSpawn. -}+promptSelection, safePromptSelection, unsafePromptSelection :: String -> X ()+promptSelection = unsafePromptSelection+safePromptSelection app = join $ io $ liftM (safeSpawn app) getSelection+unsafePromptSelection app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) getSelection++{- | A wrapper around 'promptSelection' and its safe variant. They take two parameters, the first is a function that transforms strings, and the second is the application to run. The transformer essentially transforms the selection in X.+One example is to wrap code, such as a command line action copied out of the browser to be run as '"sudo" ++ cmd' or '"su - -c \"" ++ cmd ++ "\"".+-}+transformPromptSelection, transformSafePromptSelection :: (String -> String) -> String -> X ()+transformPromptSelection f app = join $ io $ liftM (safeSpawn app) (fmap f getSelection)+transformSafePromptSelection f app = join $ io $ liftM unsafeSpawn $ fmap (\x -> app ++ " " ++ x) (fmap f getSelection)
+ XMonad/Util/XUtils.hs view
@@ -0,0 +1,170 @@+-----------------------------------------------------------------------------+-- |+-- 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+    , showWindows+    , hideWindow+    , hideWindows+    , deleteWindow+    , deleteWindows+    , paintWindow+    , paintAndWrite+    , stringToPixel+    , fi+    ) 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 -> Bool -> X Window+createNewWindow (Rectangle x y w h) m col o = do+  d   <- asks display+  rw  <- asks theRoot+  c   <- stringToPixel d col+  win <- io $ mkWindow d (defaultScreenOfDisplay d) rw x y w h c o+  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++-- | the list version+showWindows :: [Window] -> X ()+showWindows = mapM_ showWindow++-- | unmap a window+hideWindow :: Window -> X ()+hideWindow w = do+  d <- asks display+  io $ unmapWindow d w++-- | the list version+hideWindows :: [Window] -> X ()+hideWindows = mapM_ hideWindow++-- | destroy a window+deleteWindow :: Window -> X ()+deleteWindow w = do+  d <- asks display+  io $ destroyWindow d w++-- | the list version+deleteWindows :: [Window] -> X ()+deleteWindows = mapM_ deleteWindow++-- | Fill a window with a rectangle and a border+paintWindow :: Window     -- ^ The window where to draw+            -> Dimension  -- ^ Window width+            -> 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 number of strings to given positions+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'ments+              -> [String]   -- ^ Strings to be printed+              -> X ()+paintAndWrite w fs wh ht bw bc borc ffc fbc als strs = do+    d <- asks display+    strPositions <- forM (zip als strs) $ \(al, str) ->+        stringPosition d fs (Rectangle 0 0 wh ht) al str+    let ms = Just (fs,ffc,fbc, zip strs strPositions)+    paintWindow' w (Rectangle 0 0 wh ht) bw bc borc ms++-- This stuff is not exported++paintWindow' :: Window -> Rectangle -> Dimension -> String -> String -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) -> X ()+paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff = 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 strStuff) $ do+    let (xmf,fc,bc,strAndPos) = fromJust strStuff+    forM_ strAndPos $ \(s, (x, y)) ->+        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++-- | Creates a window with the possibility of setting some attributes.+-- Not exported.+mkWindow :: Display -> Screen -> Window -> Position+         -> Position -> Dimension -> Dimension -> Pixel -> Bool -> IO Window+mkWindow d s rw x y w h p o = do+  let visual = defaultVisualOfScreen s+      attrmask = cWOverrideRedirect .|. cWBackPixel .|. cWBorderPixel+  allocaSetWindowAttributes $+         \attributes -> do+           set_override_redirect attributes o+           set_border_pixel      attributes p+           set_background_pixel  attributes p+           createWindow d rw x y w h 0 (defaultDepthOfScreen s)+                        inputOutput visual attrmask attributes++-- | 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-bluetilebranch.cabal view
@@ -0,0 +1,225 @@+name:               xmonad-contrib-bluetilebranch+version:            0.8.1+homepage:           http://xmonad.org/+synopsis:           Third party extensions for xmonad+description:        This is a modified version of xmonad-contrib used by Bluetile.+category:           System+license:            BSD3+license-file:       LICENSE+author:             Spencer Janssen+maintainer:         jan.vornberger@informatik.uni-oldenburg.de+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+build-type:         Simple++flag small_base+  description: Choose the new smaller, split-up base package.++flag use_xft+  description: Use Xft to render text++flag testing+  description: Testing mode+  default: False++library+    if flag(small_base)+        build-depends: base >= 3 && < 4, containers, directory, process, random, old-time, old-locale+    else+        build-depends: base < 3++    if flag(use_xft)+        build-depends: X11-xft >= 0.2, utf8-string+        extensions: ForeignFunctionInterface+        cpp-options: -DXFT++    build-depends:      mtl, unix, X11>=1.4.3, xmonad-bluetilebranch>=0.8, xmonad-bluetilebranch<0.9, utf8-string+    ghc-options:        -Wall+    extensions:         ForeignFunctionInterface+    cpp-options:        -DUSE_UTF8++    if flag(testing)+        ghc-options:    -Werror++    if impl (ghc == 6.10.1) && arch (x86_64)+        ghc-options:    -O0++    exposed:            False+    exposed-modules:    XMonad.Doc+                        XMonad.Doc.Configuring+                        XMonad.Doc.Extending+                        XMonad.Doc.Developing+                        XMonad.Actions.BluetileCommands+                        XMonad.Actions.Commands+                        XMonad.Actions.ConstrainedResize+                        XMonad.Actions.CopyWindow+                        XMonad.Actions.CycleRecentWS+                        XMonad.Actions.CycleSelectedLayouts+                        XMonad.Actions.CycleWindows+                        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.GridSelect+                        XMonad.Actions.MessageFeedback+                        XMonad.Actions.MouseGestures+                        XMonad.Actions.MouseResize+                        XMonad.Actions.NoBorders+                        XMonad.Actions.PerWorkspaceKeys+                        XMonad.Actions.PhysicalScreens+                        XMonad.Actions.Plane+                        XMonad.Actions.Promote+                        XMonad.Actions.RotSlaves+                        XMonad.Actions.Search+                        XMonad.Actions.SimpleDate+                        XMonad.Actions.SinkAll+                        XMonad.Actions.SpawnOn+                        XMonad.Actions.Submap+                        XMonad.Actions.SwapWorkspaces+                        XMonad.Actions.TagWindows+                        XMonad.Actions.TopicSpace+                        XMonad.Actions.UpdatePointer+                        XMonad.Actions.UpdateFocus+                        XMonad.Actions.Warp+                        XMonad.Actions.WindowMenu+                        XMonad.Actions.WindowNavigation+                        XMonad.Actions.WindowGo+                        XMonad.Actions.WindowBringer+                        XMonad.Actions.WithAll+                        XMonad.Config.Arossato+                        XMonad.Config.Azerty+                        XMonad.Config.Desktop+                        XMonad.Config.Droundy+                        XMonad.Config.Gnome+                        XMonad.Config.Kde+                        XMonad.Config.Sjanssen+                        XMonad.Config.Xfce+                        XMonad.Hooks.BluetileDock+                        XMonad.Hooks.CustomRestart+                        XMonad.Hooks.DynamicHooks+                        XMonad.Hooks.DynamicLog+                        XMonad.Hooks.EventHook+                        XMonad.Hooks.EwmhDesktops+                        XMonad.Hooks.FadeInactive+                        XMonad.Hooks.FloatNext+                        XMonad.Hooks.InsertPosition+                        XMonad.Hooks.ManageDocks+                        XMonad.Hooks.ManageHelpers+                        XMonad.Hooks.Place+                        XMonad.Hooks.RestoreMinimized+                        XMonad.Hooks.Script+                        XMonad.Hooks.SetWMName+                        XMonad.Hooks.ServerMode+                        XMonad.Hooks.UrgencyHook+                        XMonad.Hooks.WorkspaceByPos+                        XMonad.Hooks.XPropManage+                        XMonad.Layout.Accordion+                        XMonad.Layout.BorderResize+                        XMonad.Layout.BoringWindows+                        XMonad.Layout.CenteredMaster+                        XMonad.Layout.Circle+                        XMonad.Layout.Cross+                        XMonad.Layout.Combo+                        XMonad.Layout.ComboP+                        XMonad.Layout.Decoration+                        XMonad.Layout.DecorationMadness+                        XMonad.Layout.DecorationUtils+                        XMonad.Layout.Dishes+                        XMonad.Layout.DraggingVisualizer+                        XMonad.Layout.DragPane+                        XMonad.Layout.DwmStyle+                        XMonad.Layout.FixedColumn+                        XMonad.Layout.Gaps+                        XMonad.Layout.Grid+                        XMonad.Layout.GridVariants+                        XMonad.Layout.HintedGrid+                        XMonad.Layout.HintedTile+                        XMonad.Layout.IM+                        XMonad.Layout.IndependentScreens+                        XMonad.Layout.LayoutBuilder+                        XMonad.Layout.LayoutCombinators+                        XMonad.Layout.LayoutHints+                        XMonad.Layout.LayoutModifier+                        XMonad.Layout.LayoutScreens+                        XMonad.Layout.MagicFocus+                        XMonad.Layout.Magnifier+                        XMonad.Layout.Master+                        XMonad.Layout.Maximize+                        XMonad.Layout.Minimize+                        XMonad.Layout.Monitor+                        XMonad.Layout.Mosaic+                        XMonad.Layout.MosaicAlt+                        XMonad.Layout.MouseResizableTile+                        XMonad.Layout.MultiToggle+                        XMonad.Layout.MultiToggle.Instances+                        XMonad.Layout.Named+                        XMonad.Layout.NoBorders+                        XMonad.Layout.NoFrillsDecoration+                        XMonad.Layout.OneBig+                        XMonad.Layout.PerWorkspace+                        XMonad.Layout.PositionStoreFloat+                        XMonad.Layout.Reflect+                        XMonad.Layout.ResizableTile+                        XMonad.Layout.ResizeScreen+                        XMonad.Layout.Roledex+                        XMonad.Layout.Simplest+                        XMonad.Layout.SimpleDecoration+                        XMonad.Layout.SimpleFloat+                        XMonad.Layout.Spiral+                        XMonad.Layout.Square+                        XMonad.Layout.ShowWName+                        XMonad.Layout.StackTile+                        XMonad.Layout.SubLayouts+                        XMonad.Layout.Tabbed+                        XMonad.Layout.TabBarDecoration+                        XMonad.Layout.ThreeColumns+                        XMonad.Layout.ThreeColumnsMiddle+                        XMonad.Layout.ToggleLayouts+                        XMonad.Layout.TwoPane+                        XMonad.Layout.WindowArranger+                        XMonad.Layout.WindowNavigation+                        XMonad.Layout.WindowSwitcherDecoration+                        XMonad.Layout.WorkspaceDir+                        XMonad.Layout.SimplestFloat+                        XMonad.Prompt.Directory+                        XMonad.Prompt+                        XMonad.Prompt.AppendFile+                        XMonad.Prompt.AppLauncher+                        XMonad.Prompt.Input+                        XMonad.Prompt.Email+                        XMonad.Prompt.Layout+                        XMonad.Prompt.Man+                        XMonad.Prompt.DirExec+                        XMonad.Prompt.RunOrRaise+                        XMonad.Prompt.Shell+                        XMonad.Prompt.Ssh+                        XMonad.Prompt.Theme+                        XMonad.Prompt.Window+                        XMonad.Prompt.Workspace+                        XMonad.Prompt.XMonad+                        XMonad.Util.CustomKeys+                        XMonad.Util.Dmenu+                        XMonad.Util.Dzen+                        XMonad.Util.EZConfig+                        XMonad.Util.Font+                        XMonad.Util.Invisible+                        XMonad.Util.Loggers+                        XMonad.Util.NamedScratchpad+                        XMonad.Util.NamedWindows+                        XMonad.Util.Run+                        XMonad.Util.Scratchpad+                        XMonad.Util.Themes+                        XMonad.Util.Timer+                        XMonad.Util.WindowProperties+                        XMonad.Util.WorkspaceCompare+                        XMonad.Util.Paste+                        XMonad.Util.XSelection+                        XMonad.Util.XUtils