xmonad-contrib 0.10 → 0.11

raw patch · 66 files changed

+3683/−359 lines, 66 filesdep ~X11dep ~basedep ~xmonadPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: X11, base, xmonad

API changes (from Hackage documentation)

Files

• XMonad/Actions/DynamicWorkspaceOrder.hs +13/−0
• XMonad/Actions/DynamicWorkspaces.hs +8/−5
• XMonad/Actions/FindEmptyWorkspace.hs +6/−1
• XMonad/Actions/GridSelect.hs +34/−6
• XMonad/Actions/GroupNavigation.hs +9/−9
• XMonad/Actions/KeyRemap.hs +2/−2
• XMonad/Actions/Launcher.hs +123/−0
• XMonad/Actions/Navigation2D.hs +778/−0
• XMonad/Actions/PhysicalScreens.hs +1/−2
• XMonad/Actions/Plane.hs +2/−2
• XMonad/Actions/ShowText.hs +116/−0
• XMonad/Actions/TagWindows.hs +2/−3
• XMonad/Actions/WindowGo.hs +1/−1
• XMonad/Actions/Workscreen.hs +109/−0
• XMonad/Doc/Extending.hs +2/−2
• XMonad/Hooks/DebugEvents.hs +1254/−0
• XMonad/Hooks/DebugKeyEvents.hs +1/−1
• XMonad/Hooks/DebugStack.hs +93/−0
• XMonad/Hooks/DynamicBars.hs +136/−0
• XMonad/Hooks/EwmhDesktops.hs +22/−13
• XMonad/Hooks/FadeInactive.hs +27/−6
• XMonad/Hooks/FadeWindows.hs +1/−1
• XMonad/Hooks/ICCCMFocus.hs +4/−19
• XMonad/Hooks/ManageDocks.hs +2/−2
• XMonad/Hooks/Script.hs +3/−5
• XMonad/Hooks/ToggleHook.hs +2/−1
• XMonad/Hooks/UrgencyHook.hs +40/−1
• XMonad/Hooks/XPropManage.hs +2/−3
• XMonad/Layout/BorderResize.hs +5/−7
• XMonad/Layout/Fullscreen.hs +8/−8
• XMonad/Layout/Groups.hs +19/−19
• XMonad/Layout/Groups/Examples.hs +9/−9
• XMonad/Layout/Groups/Helpers.hs +3/−3
• XMonad/Layout/Groups/Wmii.hs +11/−11
• XMonad/Layout/ImageButtonDecoration.hs +1/−1
• XMonad/Layout/LayoutBuilderP.hs +1/−1
• XMonad/Layout/Minimize.hs +3/−3
• XMonad/Layout/MouseResizableTile.hs +37/−37
• XMonad/Layout/OnHost.hs +155/−0
• XMonad/Layout/Renamed.hs +1/−1
• XMonad/Layout/ShowWName.hs +5/−5
• XMonad/Layout/Spacing.hs +15/−0
• XMonad/Layout/Spiral.hs +1/−1
• XMonad/Layout/TrackFloating.hs +2/−2
• XMonad/Layout/WindowNavigation.hs +5/−5
• XMonad/Layout/WorkspaceDir.hs +1/−8
• XMonad/Layout/ZoomRow.hs +7/−7
• XMonad/Prompt.hs +357/−85
• XMonad/Prompt/DirExec.hs +2/−3
• XMonad/Prompt/RunOrRaise.hs +2/−3
• XMonad/Prompt/Shell.hs +26/−17
• XMonad/Prompt/Ssh.hs +2/−4
• XMonad/Util/DebugWindow.hs +140/−0
• XMonad/Util/Dmenu.hs +1/−1
• XMonad/Util/Font.hs +4/−5
• XMonad/Util/Image.hs +1/−1
• XMonad/Util/Loggers.hs +2/−3
• XMonad/Util/NamedScratchpad.hs +19/−1
• XMonad/Util/NamedWindows.hs +3/−4
• XMonad/Util/Paste.hs +3/−9
• XMonad/Util/Run.hs +9/−0
• XMonad/Util/Stack.hs +2/−2
• XMonad/Util/Themes.hs +2/−2
• XMonad/Util/XSelection.hs +1/−1
• XMonad/Util/XUtils.hs +2/−2
• xmonad-contrib.cabal +23/−3

@@ -28,6 +28,8 @@     , moveToGreedy     , shiftTo +    , withNthWorkspace+     ) where  import XMonad@@ -163,3 +165,14 @@ -- given type in the given direction, using the dynamic workspace order. shiftTo :: Direction1D -> WSType -> X () shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)++-- | Do something with the nth workspace in the dynamic order.  The+--   callback is given the workspace's tag as well as the 'WindowSet'+--   of the workspace itself.+withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()+withNthWorkspace job wnum = do+  sort <- getSortByOrder+  ws <- gets (map W.tag . sort . W.workspaces . windowset)+  case drop wnum ws of+    (w:_) -> windows $ job w+    []    -> return ()

@@ -23,6 +23,7 @@                                          addHiddenWorkspace,                                          withWorkspace,                                          selectWorkspace, renameWorkspace,+                                         renameWorkspaceByName,                                          toNthWorkspace, withNthWorkspace                                        ) where @@ -73,11 +74,13 @@                          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+renameWorkspace conf = workspacePrompt conf renameWorkspaceByName++renameWorkspaceByName :: String -> X ()+renameWorkspaceByName 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

@@ -15,7 +15,7 @@ module XMonad.Actions.FindEmptyWorkspace (     -- * Usage     -- $usage-    viewEmptyWorkspace, tagToEmptyWorkspace+    viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace   ) where  import Data.List@@ -65,3 +65,8 @@ -- all workspaces are in use. tagToEmptyWorkspace :: X () tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w++-- | Send current window to an empty workspace. Do nothing if+-- all workspaces are in use.+sendToEmptyWorkspace :: X ()+sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w

@@ -74,6 +74,7 @@ import Data.Maybe import Data.Bits import Data.Char+import Data.Ord (comparing) import Control.Applicative import Control.Monad.State import Control.Arrow@@ -234,12 +235,39 @@                              }  td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]-td_elementmap s =-  let positions = td_availSlots s-      elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)-  in zipWith (,) positions elements-  where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]-        upper = map toUpper+td_elementmap s = zipWith (,) positions sortedElements+  where+    TwoDState {td_availSlots = positions,+               td_searchString = searchString} = s+    -- Filter out any elements that don't contain the searchString (case insensitive)+    filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s)+    -- Sorts the elementmap+    sortedElements = orderElementmap searchString filteredElements+    -- Case Insensitive version of isInfixOf+    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)+    upper = map toUpper+++-- | We enforce an ordering such that we will always get the same result. If the+-- elements position changes from call to call of gridselect, then the shown+-- positions will also change when you search for the same string. This is+-- especially the case when using gridselect for showing and switching between+-- workspaces, as workspaces are usually shown in order of last visited.  The+-- chosen ordering is "how deep in the haystack the needle is" (number of+-- characters from the beginning of the string and the needle).+orderElementmap :: String  -> [(String,a)] -> [(String,a)]+orderElementmap searchString elements = if not $ null searchString then sortedElements else elements+  where+    upper = map toUpper+    -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.+    calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element)+                        , element)+    -- Use the score and then the string as the parameters for comparing, making+    -- it consistent even when two strings that score the same, as it will then be+    -- sorted by the strings, making it consistent.+    compareScore = comparing (\(score, (str,_)) -> (score, str))+    sortedElements = map snd . sortBy compareScore $ map calcScore elements+  newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }     deriving (Monad,Functor,MonadState (TwoDState a))

@@ -20,7 +20,7 @@ -- ---------------------------------------------------------------------- -module XMonad.Actions.GroupNavigation ( -- * Usage  +module XMonad.Actions.GroupNavigation ( -- * Usage                                         -- $usage                                         Direction (..)                                       , nextMatch@@ -46,7 +46,7 @@  Import the module into your @~\/.xmonad\/xmonad.hs@: -> import XMonad.Actions,GroupNavigation+> import XMonad.Actions.GroupNavigation  To support cycling forward and backward through all xterm windows, add something like this to your keybindings:@@ -110,13 +110,13 @@ -- | Focuses the next window that matches the given boolean query.  If -- there is no such window, perform the given action instead. nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()-nextMatchOrDo dir qry act = orderedWindowList dir +nextMatchOrDo dir qry act = orderedWindowList dir                             >>= focusNextMatchOrDo qry act  -- Produces the action to perform depending on whether there's a -- matching window focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()-focusNextMatchOrDo qry act = findM (runQuery qry) +focusNextMatchOrDo qry act = findM (runQuery qry)                              >=> maybe act (windows . SS.focusWindow)  -- Returns the list of windows ordered by workspace as specified in@@ -126,7 +126,7 @@ orderedWindowList dir     = withWindowSet $ \ss -> do   wsids <- asks (Seq.fromList . workspaces . config)   let wspcs = orderedWorkspaceList ss wsids-      wins  = dirfun dir +      wins  = dirfun dir               $ Fold.foldl' (><) Seq.empty               $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs       cur   = SS.peek ss@@ -148,7 +148,7 @@ --- History navigation, requires a layout modifier -------------------  -- The state extension that holds the history information-data HistoryDB = HistoryDB (Maybe Window) -- currently focused window +data HistoryDB = HistoryDB (Maybe Window) -- currently focused window                            (Seq Window)   -- previously focused windows                deriving (Read, Show, Typeable) @@ -182,12 +182,12 @@ flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty  brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)-brkl p xs = flip Seq.splitAt xs -            $ snd +brkl p xs = flip Seq.splitAt xs+            $ snd             $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs   where     l = Seq.length xs-    + --- Some sequence helpers --------------------------------------------  -- Rotates the sequence by one position

@@ -9,7 +9,7 @@ -- Stability   :  unstable -- Portability :  unportable ----- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift +-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift -- is left us Layout -- -----------------------------------------------------------------------------@@ -42,7 +42,7 @@ -- $usage -- Provides the possibility to remap parts of the keymap to generate different keys ----- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout +-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout --   after all -- -- First, you must add all possible keybindings for all layout you want to use:

@@ -0,0 +1,123 @@+{- |+Module      :  XMonad.Actions.Launcher+Copyright   :  (C) 2012 Carlos López-Camey+License     :  None; public domain++Maintainer  :  <c.lopez@kmels.net>+Stability   :  unstable++A set of prompts for XMonad+-}++module XMonad.Actions.Launcher(+  -- * Description and use+  -- $description+  defaultLauncherModes+  , ExtensionActions+  , LauncherConfig(..)+  , launcherPrompt+) where++import           Data.List       (find, findIndex, isPrefixOf, tails)+import qualified Data.Map        as M+import           Data.Maybe      (isJust)+import           XMonad          hiding (config)+import           XMonad.Prompt+import           XMonad.Util.Run++{- $description+    This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes:++       * Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock.++       * Calc: Uses the program calc to do calculations.++    To test it, modify your local .xmonad:++    > import XMonad.Prompt(defaultXPConfig)+    > import XMonad.Actions.Launcher++    > ((modm .|. controlMask, xK_l), launcherPrompt defaultXPConfig $ defaultLauncherModes launcherConfig)++    A LauncherConfig contains settings for the default modes, modify them accordingly.++    > launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"}++Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up.++ If you used 'defaultXPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'.+ -}++data HoogleMode = HMode FilePath String --path to hoogle and browser+data CalculatorMode = CalcMode++data LauncherConfig = LauncherConfig {+  browser        :: String+  , pathToHoogle :: String+}++type ExtensionActions = M.Map String (String -> X())++-- | Uses the command `calc` to compute arithmetic expressions+instance XPrompt CalculatorMode where+  showXPrompt CalcMode = "calc %s> "+  commandToComplete CalcMode = id --send the whole string to `calc`+  completionFunction CalcMode = \s -> if (length s == 0) then return [] else do+    fmap lines $ runProcessWithInput "calc" [s] ""+  modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard++-- | Uses the program `hoogle` to search for functions+instance XPrompt HoogleMode where+  showXPrompt _ = "hoogle %s> "+  commandToComplete _ = id+  completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]+  -- This action calls hoogle again to find the URL corresponding to the autocompleted item+  modeAction (HMode pathToHoogleBin'' browser') query result = do+    completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]+    let link = do+          s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink+          i <- findSeqIndex s "http://"+          return $ drop i s+    case link of+       Just l -> spawn $ browser' ++ " " ++ l+       _      -> return ()+    where+      -- | Receives a sublist and a list. It returns the index where the sublist appears in the list.+      findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int+      findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs++-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.+completionFunctionWith :: String -> [String] -> IO [String]+completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""++-- | Creates a prompt with the given modes+launcherPrompt :: XPConfig -> [XPMode] -> X()+launcherPrompt config modes = mkXPromptWithModes modes config++-- | Create a list of modes based on :+-- a list of extensions mapped to actions+-- the path to hoogle+defaultLauncherModes :: LauncherConfig -> [XPMode]+defaultLauncherModes cnf = let+  ph           = pathToHoogle cnf+  in [ hoogleMode ph $ browser cnf+     , calcMode]++hoogleMode :: FilePath -> String -> XPMode+hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser'+calcMode :: XPMode+calcMode = XPT CalcMode++{-++  -- ideas for XMonad.Prompt running on mode XPMultipleModes+     * Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g)++     * Support for actions of type String -> X a++  -- ideas for this module++     * Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?)++     * Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json)+-}

@@ -0,0 +1,778 @@+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.Navigation2D+-- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  Norbert Zeh <nzeh@cs.dal.ca>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Navigation2D is an xmonad extension that allows easy directional+-- navigation of windows and screens (in a multi-monitor setup).+-----------------------------------------------------------------------------++module XMonad.Actions.Navigation2D ( -- * Usage+                                     -- $usage++                                     -- * Finer points+                                     -- $finer_points++                                     -- * Alternative directional navigation modules+                                     -- $alternatives++                                     -- * Incompatibilities+                                     -- $incompatibilities++                                     -- * Detailed technical discussion+                                     -- $technical++                                     -- * Exported functions and types+                                     -- #Exports#++                                     withNavigation2DConfig+                                   , Navigation2DConfig(..)+                                   , defaultNavigation2DConfig+                                   , Navigation2D+                                   , lineNavigation+                                   , centerNavigation+                                   , fullScreenRect+                                   , singleWindowRect+                                   , switchLayer+                                   , windowGo+                                   , windowSwap+                                   , windowToScreen+                                   , screenGo+                                   , screenSwap+                                   , Direction2D(..)+                                   ) where++import Control.Applicative+import qualified Data.List as L+import qualified Data.Map as M+import Data.Maybe+import XMonad hiding (Screen)+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Util.Types++-- $usage+-- #Usage#+-- Navigation2D provides directional navigation (go left, right, up, down) for+-- windows and screens.  It treats floating and tiled windows as two separate+-- layers and provides mechanisms to navigate within each layer and to switch+-- between layers.  Navigation2D provides two different navigation strategies+-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather+-- natural but may make it impossible to navigate to a given window from the+-- current window, particularly in the floating layer.  /Center navigation/+-- feels less natural in certain situations but ensures that all windows can be+-- reached without the need to involve the mouse.  Navigation2D allows different+-- navigation strategies to be used in the two layers and allows customization+-- of the navigation strategy for the tiled layer based on the layout currently+-- in effect.+--+-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.Navigation2D+--+-- Then edit your keybindings:+--+-- >    -- Switch between layers+-- >    , ((modm,                 xK_space), switchLayers)+-- >+-- >    -- Directional navigation of windows+-- >    , ((modm,                 xK_Right), windowGo R False)+-- >    , ((modm,                 xK_Left ), windowGo L False)+-- >    , ((modm,                 xK_Up   ), windowGo U False)+-- >    , ((modm,                 xK_Down ), windowGo D False)+-- >+-- >    -- Swap adjacent windows+-- >    , ((modm .|. controlMask, xK_Right), windowSwap R False)+-- >    , ((modm .|. controlMask, xK_Left ), windowSwap L False)+-- >    , ((modm .|. controlMask, xK_Up   ), windowSwap U False)+-- >    , ((modm .|. controlMask, xK_Down ), windowSwap D False)+-- >+-- >    -- Directional navigation of screens+-- >    , ((modm,                 xK_r    ), screenGo R False)+-- >    , ((modm,                 xK_l    ), screenGo L False)+-- >    , ((modm,                 xK_u    ), screenGo U False)+-- >    , ((modm,                 xK_d    ), screenGo D False)+-- >+-- >    -- Swap workspaces on adjacent screens+-- >    , ((modm .|. controlMask, xK_r    ), screenSwap R False)+-- >    , ((modm .|. controlMask, xK_l    ), screenSwap L False)+-- >    , ((modm .|. controlMask, xK_u    ), screenSwap U False)+-- >    , ((modm .|. controlMask, xK_d    ), screenSwap D False)+-- >+-- >    -- Send window to adjacent screen+-- >    , ((modm .|. mod1Mask,    xK_r    ), windowToScreen R False)+-- >    , ((modm .|. mod1Mask,    xK_l    ), windowToScreen L False)+-- >    , ((modm .|. mod1Mask,    xK_u    ), windowToScreen U False)+-- >    , ((modm .|. mod1Mask,    xK_d    ), windowToScreen D False)+--+-- and add the configuration of the module to your main function:+--+-- > main = xmonad $ withNavigation2DConfig defaultNavigation2DConfig+-- >               $ defaultConfig+--+-- For detailed instruction on editing the key binding see:+--+-- "XMonad.Doc.Extending#Editing_key_bindings".++-- $finer_points+-- #Finer_Points#+-- The above should get you started.  Here are some finer points:+--+-- Navigation2D has the ability to wrap around at screen edges.  For example, if+-- you navigated to the rightmost window on the rightmost screen and you+-- continued to go right, this would get you to the leftmost window on the+-- leftmost screen.  This feature may be useful for switching between screens+-- that are far apart but may be confusing at least to novice users.  Therefore,+-- it is disabled in the above example (e.g., navigation beyond the rightmost+-- window on the rightmost screen is not possible and trying to do so will+-- simply not do anything.)  If you want this feature, change all the 'False'+-- values in the above example to 'True'.  You could also decide you want+-- wrapping only for a subset of the operations and no wrapping for others.+--+-- By default, all layouts use the 'defaultTiledNavigation' strategy specified+-- in the 'Navigation2DConfig' (by default, line navigation is used).  To+-- override this behaviour for some layouts, add a pair (\"layout name\",+-- navigation strategy) to the 'layoutNavigation' list in the+-- 'Navigation2DConfig', where \"layout name\" is the string reported by the+-- layout's description method (normally what is shown as the layout name in+-- your status bar).  For example, all navigation strategies normally allow only+-- navigation between mapped windows.  The first step to overcome this, for+-- example, for the Full layout, is to switch to center navigation for the Full+-- layout:+--+-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation = [("Full", centerNavigation)] }+-- >+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig+-- >               $ defaultConfig+--+-- The navigation between windows is based on their screen rectangles, which are+-- available /and meaningful/ only for mapped windows.  Thus, as already said,+-- the default is to allow navigation only between mapped windows.  However,+-- there are layouts that do not keep all windows mapped.  One example is the+-- Full layout, which unmaps all windows except the one that has the focus,+-- thereby preventing navigation to any other window in the layout.  To make+-- navigation to unmapped windows possible, unmapped windows need to be assigned+-- rectangles to pretend they are mapped, and a natural way to do this for the+-- Full layout is to pretend all windows occupy the full screen and are stacked+-- on top of each other so that only the frontmost one is visible.  This can be+-- done as follows:+--+-- > myNavigation2DConfig = defaultNavigation2DConfig { layoutNavigation   = [("Full", centerNavigation)]+-- >                                                  , unmappedWindowRect = [("Full", singleWindowRect)]+-- >                                                  }+-- >+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig+-- >               $ defaultConfig+--+-- With this setup, Left/Up navigation behaves like standard+-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like+-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the+-- layout.+--+-- In general, each entry in the 'unmappedWindowRect' association list is a pair+-- (\"layout description\", function), where the function computes a rectangle+-- for each unmapped window from the screen it is on and the window ID.+-- Currently, Navigation2D provides only two functions of this type:+-- 'singleWindowRect' and 'fullScreenRect'.+--+-- With per-layout navigation strategies, if different layouts are in effect on+-- different screens in a multi-monitor setup, and different navigation+-- strategies are defined for these active layouts, the most general of these+-- navigation strategies is used across all screens (because Navigation2D does+-- not distinguish between windows on different workspaces), where center+-- navigation is more general than line navigation, as discussed formally under+-- <#Technical_Discussion>.++-- $alternatives+-- #Alternatives#+--+-- There exist two alternatives to Navigation2D:+-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".+-- X.L.WindowNavigation has the advantage of colouring windows to indicate the+-- window that would receive the focus in each navigation direction, but it does+-- not support navigation across multiple monitors, does not support directional+-- navigation of floating windows, and has a very unintuitive definition of+-- which window receives the focus next in each direction.  X.A.WindowNavigation+-- does support navigation across multiple monitors but does not provide window+-- colouring while retaining the unintuitive navigational semantics of+-- X.L.WindowNavigation.  This makes it very difficult to predict which window+-- receives the focus next.  Neither X.A.WindowNavigation nor+-- X.L.WindowNavigation supports directional navigation of screens.++-- $technical+-- #Technical_Discussion#+-- An in-depth discussion of the navigational strategies implemented in+-- Navigation2D, including formal proofs of their properties, can be found+-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.++-- $incompatibilities+-- #Incompatibilities#+-- Currently Navigation2D is known not to play nicely with tabbed layouts, but+-- it should work well with any other tiled layout.  My hope is to address the+-- incompatibility with tabbed layouts in a future version.  The navigation to+-- unmapped windows, for example in a Full layout, by assigning rectangles to+-- unmapped windows is more a workaround than a clean solution.  Figuring out+-- how to deal with tabbed layouts may also lead to a more general and cleaner+-- solution to query the layout for a window's rectangle that may make this+-- workaround unnecessary.  At that point, the 'unmappedWindowRect' field of the+-- 'Navigation2DConfig' will disappear.++-- | A rectangle paired with an object+type Rect a = (a, Rectangle)++-- | A shorthand for window-rectangle pairs.  Reduces typing.+type WinRect = Rect Window++-- | A shorthand for workspace-rectangle pairs.  Reduces typing.+type WSRect = Rect WorkspaceId++----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------+--                                                                                                --+--                                        PUBLIC INTERFACE                                        --+--                                                                                                --+----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------++-- | Encapsulates the navigation strategy+data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)++runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)+runNav (N _ nav) = nav++-- | Score that indicates how general a navigation strategy is+type Generality = Int++instance Eq Navigation2D where+  (N x _) == (N y _) = x == y++instance Ord Navigation2D where+  (N x _) <= (N y _) = x <= y++-- | Line navigation.  To illustrate this navigation strategy, consider+-- navigating to the left from the current window.  In this case, we draw a+-- horizontal line through the center of the current window and consider all+-- windows that intersect this horizontal line and whose right boundaries are to+-- the left of the left boundary of the current window.  From among these+-- windows, we choose the one with the rightmost right boundary.+lineNavigation :: Navigation2D+lineNavigation = N 1 doLineNavigation++-- | Center navigation.  Again, consider navigating to the left.  Then we+-- consider the cone bounded by the two rays shot at 45-degree angles in+-- north-west and south-west direction from the center of the current window.  A+-- window is a candidate to receive the focus if its center lies in this cone.+-- We choose the window whose center has minimum L1-distance from the current+-- window center.  The tie breaking strategy for windows with the same distance+-- is a bit complicated (see <#Technical_Discussion>) but ensures that all+-- windows can be reached and that windows with the same center are traversed in+-- their order in the window stack, that is, in the order+-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse+-- them.+centerNavigation :: Navigation2D+centerNavigation = N 2 doCenterNavigation++-- | Stores the configuration of directional navigation+data Navigation2DConfig = Navigation2DConfig+  { defaultTiledNavigation :: Navigation2D             -- ^ default navigation strategy for the tiled layer+  , floatNavigation        :: Navigation2D             -- ^ navigation strategy for the float layer+  , screenNavigation       :: Navigation2D             -- ^ strategy for navigation between screens+  , layoutNavigation       :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies+                                                       -- for different layouts in the tiled layer.  Each pair+                                                       -- is of the form (\"layout description\", navigation+                                                       -- strategy).  If there is no pair in this list whose first+                                                       -- component is the name of the current layout, the+                                                       -- 'defaultTiledNavigation' strategy is used.+  , unmappedWindowRect     :: [(String, Screen -> Window -> X (Maybe Rectangle))]+                                                       -- ^ list associating functions to calculate rectangles+                                                       -- for unmapped windows with layouts to which they are+                                                       -- to be applied.  Each pair in this list is of+                                                       -- the form (\"layout description\", function), where the+                                                       -- function calculates a rectangle for a given unmapped+                                                       -- window from the screen it is on and its window ID.+                                                       -- See <#Finer_Points> for how to use this.+  } deriving Typeable++-- | Shorthand for the tedious screen type+type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail++-- So we can store the configuration in extensible state+instance ExtensionClass Navigation2DConfig where+  initialValue = defaultNavigation2DConfig++-- | Modifies the xmonad configuration to store the Navigation2D configuration+withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a+withNavigation2DConfig conf2d xconf = xconf { startupHook  = startupHook xconf+                                                          >> XS.put conf2d+                                            }++-- | Default navigation configuration.  It uses line navigation for the tiled+-- layer and for navigation between screens, and center navigation for the float+-- layer.  No custom navigation strategies or rectangles for unmapped windows are+-- defined for individual layouts.+defaultNavigation2DConfig :: Navigation2DConfig+defaultNavigation2DConfig = Navigation2DConfig { defaultTiledNavigation = lineNavigation+                                               , floatNavigation        = centerNavigation+                                               , screenNavigation       = lineNavigation+                                               , layoutNavigation       = []+                                               , unmappedWindowRect     = []+                                               }++-- | Switches focus to the closest window in the other layer (floating if the+-- current window is tiled, tiled if the current window is floating).  Closest+-- means that the L1-distance between the centers of the windows is minimized.+switchLayer :: X ()+switchLayer = actOnLayer otherLayer+                         ( \ _ cur wins -> windows+                           $ doFocusClosestWindow cur wins+                         )+                         ( \ _ cur wins -> windows+                           $ doFocusClosestWindow cur wins+                         )+                         ( \ _ _ _ -> return () )+                         False++-- | Moves the focus to the next window in the given direction and in the same+-- layer as the current window.  The second argument indicates whether+-- navigation should wrap around (e.g., from the left edge of the leftmost+-- screen to the right edge of the rightmost screen).+windowGo :: Direction2D -> Bool -> X ()+windowGo dir wrap = actOnLayer thisLayer+                               ( \ conf cur wins -> windows+                                 $ doTiledNavigation conf dir W.focusWindow cur wins+                               )+                               ( \ conf cur wins -> windows+                                 $ doFloatNavigation conf dir W.focusWindow cur wins+                               )+                               ( \ conf cur wspcs -> windows+                                 $ doScreenNavigation conf dir W.view cur wspcs+                               )+                               wrap++-- | Swaps the current window with the next window in the given direction and in+-- the same layer as the current window.  (In the floating layer, all that+-- changes for the two windows is their stacking order if they're on the same+-- screen.  If they're on different screens, each window is moved to the other+-- window's screen but retains its position and size relative to the screen.)+-- The second argument indicates wrapping (see 'windowGo').+windowSwap :: Direction2D -> Bool -> X ()+windowSwap dir wrap = actOnLayer thisLayer+                                 ( \ conf cur wins -> windows+                                   $ doTiledNavigation conf dir swap cur wins+                                 )+                                 ( \ conf cur wins -> windows+                                   $ doFloatNavigation conf dir swap cur wins+                                 )+                                 ( \ _ _ _ -> return () )+                                 wrap++-- | Moves the current window to the next screen in the given direction.  The+-- second argument indicates wrapping (see 'windowGo').+windowToScreen :: Direction2D -> Bool -> X ()+windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows+                                         $ doScreenNavigation conf dir W.shift cur wspcs+                                       )+                                       wrap++-- | Moves the focus to the next screen in the given direction.  The second+-- argument indicates wrapping (see 'windowGo').+screenGo :: Direction2D -> Bool -> X ()+screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows+                                   $ doScreenNavigation conf dir W.view cur wspcs+                                 )+                                 wrap++-- | Swaps the workspace on the current screen with the workspace on the screen+-- in the given direction.  The second argument indicates wrapping (see+-- 'windowGo').+screenSwap :: Direction2D -> Bool -> X ()+screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows+                                     $ doScreenNavigation conf dir W.greedyView cur wspcs+                                   )+                                   wrap++-- | Maps each window to a fullscreen rect.  This may not be the same rectangle the+-- window maps to under the Full layout or a similar layout if the layout+-- respects statusbar struts.  In such cases, it may be better to use+-- 'singleWindowRect'.+fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)+fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)++-- | Maps each window to the rectangle it would receive if it was the only+-- window in the layout.  Useful, for example, for determining the default+-- rectangle for unmapped windows in a Full layout that respects statusbar+-- struts.+singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)+singleWindowRect scr win  =  listToMaybe+                          .  map snd+                          .  fst+                         <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })+                                       (screenRect . W.screenDetail $ scr)++----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------+--                                                                                                --+--                                       PRIVATE X ACTIONS                                        --+--                                                                                                --+----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------++-- | Acts on the appropriate layer using the given action functions+actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])                -- ^ Chooses which layer to operate on, relative+                                                                   -- to the current window (same or other layer)+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer+           -> (Navigation2DConfig -> WSRect  -> [WSRect]  -> X ()) -- ^ The action if the current workspace is empty+           -> Bool                                                 -- ^ Should navigation wrap around screen edges?+           -> X ()+actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do+  conf <- XS.get+  (floating, tiled) <- navigableWindows conf wrap winset+  let cur = W.peek winset+  case cur of+    Nothing                                   -> actOnScreens wsact wrap+    Just w | Just rect <- L.lookup w tiled    -> tiledact conf (w, rect) (choice tiled floating)+           | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)+           | otherwise                        -> return ()++-- | Returns the list of windows on the currently visible workspaces+navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])+navigableWindows conf wrap winset  =  L.partition (\(win, _) -> M.member win (W.floating winset))+                                   .  addWrapping winset wrap+                                   .  catMaybes+                                   .  concat+                                  <$>+                                   (  mapM ( \scr -> mapM (maybeWinRect scr)+                                                   $ W.integrate'+                                                   $ W.stack+                                                   $ W.workspace scr+                                           )+                                   .  sortedScreens+                                   )  winset+  where+    maybeWinRect scr win = do+      winrect <- windowRect win+      rect <- case winrect of+                Just _  -> return winrect+                Nothing -> maybe (return Nothing)+                                 (\f -> f scr win)+                                 (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))+      return ((,) win <$> rect)++-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped+windowRect :: Window -> X (Maybe Rectangle)+windowRect win = withDisplay $ \dpy -> do+  mp <- isMapped win+  if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win+                return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)+                `catchX` return Nothing+        else return Nothing++-- | Acts on the screens using the given action function+actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())+             -> Bool  -- ^ Should wrapping be used?+             -> X ()+actOnScreens act wrap = withWindowSet $ \winset -> do+  conf <- XS.get+  let wsrects = visibleWorkspaces winset wrap+      cur     = W.tag . W.workspace . W.current $ winset+      rect    = fromJust $ L.lookup cur wsrects+  act conf (cur, rect) wsrects++-- | Determines whether a given window is mapped+isMapped :: Window -> X Bool+isMapped win  =  withDisplay+              $  \dpy -> io+              $  (waIsUnmapped /=)+              .  wa_map_state+             <$> getWindowAttributes dpy win++----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------+--                                                                                                --+--                                     PRIVATE PURE FUNCTIONS                                     --+--                                                                                                --+----------------------------------------------------------------------------------------------------+----------------------------------------------------------------------------------------------------++-- | Finds the window closest to the given window and focuses it. Ties are+-- broken by choosing the first window in the window stack among the tied+-- windows.  (The stack order is the one produced by integrate'ing each visible+-- workspace's window stack and concatenating these lists for all visible+-- workspaces.)+doFocusClosestWindow :: WinRect+                     -> [WinRect]+                     -> (WindowSet -> WindowSet)+doFocusClosestWindow (cur, rect) winrects+  | null winctrs = id+  | otherwise    = W.focusWindow . fst $ L.foldl1' closer winctrs+  where+    ctr     = centerOf rect+    winctrs = filter ((cur /=) . fst)+            $ map (\(w, r) -> (w, centerOf r)) winrects+    closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2+                                   | otherwise                   = wc1++-- | Implements navigation for the tiled layer+doTiledNavigation :: Navigation2DConfig+                  -> Direction2D+                  -> (Window -> WindowSet -> WindowSet)+                  -> WinRect+                  -> [WinRect]+                  -> (WindowSet -> WindowSet)+doTiledNavigation conf dir act cur winrects winset+  | Just win <- runNav nav dir cur winrects = act win winset+  | otherwise                               = winset+  where+    layouts = map (description . W.layout . W.workspace)+            $ W.screens winset+    nav     = maximum+            $ map ( fromMaybe (defaultTiledNavigation conf)+                  . flip L.lookup (layoutNavigation conf)+                  )+            $ layouts++-- | Implements navigation for the float layer+doFloatNavigation :: Navigation2DConfig+                  -> Direction2D+                  -> (Window -> WindowSet -> WindowSet)+                  -> WinRect+                  -> [WinRect]+                  -> (WindowSet -> WindowSet)+doFloatNavigation conf dir act cur winrects+  | Just win <- runNav nav dir cur winrects = act win+  | otherwise                               = id+  where+    nav = floatNavigation conf++-- | Implements navigation between screens+doScreenNavigation :: Navigation2DConfig+                   -> Direction2D+                   -> (WorkspaceId -> WindowSet -> WindowSet)+                   -> WSRect+                   -> [WSRect]+                   -> (WindowSet -> WindowSet)+doScreenNavigation conf dir act cur wsrects+  | Just ws <- runNav nav dir cur wsrects = act ws+  | otherwise                             = id+  where+    nav = screenNavigation conf++-- | Implements line navigation.  For layouts without overlapping windows, there+-- is no need to break ties between equidistant windows.  When windows do+-- overlap, even the best tie breaking rule cannot make line navigation feel+-- natural.  Thus, we fairly arbtitrarily break ties by preferring the window+-- that comes first in the window stack.  (The stack order is the one produced+-- by integrate'ing each visible workspace's window stack and concatenating+-- these lists for all visible workspaces.)+doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a+doLineNavigation dir (cur, rect) winrects+  | null winrects' = Nothing+  | otherwise      = Just . fst $ L.foldl1' closer winrects'+  where+    -- The current window's center+    ctr@(xc, yc)  = centerOf rect++    -- The list of windows that are candidates to receive focus.+    winrects'     = filter dirFilter+                  $ filter ((cur /=) . fst)+                  $ winrects++    -- Decides whether a given window matches the criteria to be a candidate to+    -- receive the focus.+    dirFilter (_, r) =  (dir == L && leftOf r rect && intersectsY yc r)+                     || (dir == R && leftOf rect r && intersectsY yc r)+                     || (dir == U && above  r rect && intersectsX xc r)+                     || (dir == D && above  rect r && intersectsX xc r)++    -- Decide whether r1 is left of/above r2.+    leftOf r1 r2 = rect_x r1 + fi (rect_width  r1) <= rect_x r2+    above  r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2++    -- Check whether r's x-/y-range contains the given x-/y-coordinate.+    intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width  r) >= x+    intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y++    -- Decides whether r1 is closer to the current window's center than r2+    closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2+                                   | otherwise                 = wr1++    -- Returns the distance of r from the point (x, y)+    dist (x, y) r | dir == L  = x - rect_x r - fi (rect_width r)+                  | dir == R  = rect_x r - x+                  | dir == U  = y - rect_y r - fi (rect_height r)+                  | otherwise = rect_y r - y++-- | Implements center navigation+doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a+doCenterNavigation dir (cur, rect) winrects+  | ((w, _):_) <- onCtr' = Just w+  | otherwise            = closestOffCtr+  where+    -- The center of the current window+    (xc, yc) = centerOf rect++    -- All the windows with their center points relative to the current+    -- center rotated so the right cone becomes the relevant cone.+    -- The windows are ordered in the order they should be preferred+    -- when they are otherwise tied.+    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))+            $ stackTransform+            $ winrects++    -- Give preference to windows later in the stack for going left or up and to+    -- windows earlier in the stack for going right or down.  (The stack order+    -- is the one produced by integrate'ing each visible workspace's window+    -- stack and concatenating these lists for all visible workspaces.)+    stackTransform | dir == L || dir == U = reverse+                   | otherwise            = id++    -- Transform a point into a difference to the current window center and+    -- rotate it so that the relevant cone becomes the right cone.+    dirTransform (x, y) | dir == R  = (  x - xc ,   y - yc )+                        | dir == L  = (-(x - xc), -(y - yc))+                        | dir == D  = (  y - yc ,   x - xc )+                        | otherwise = (-(y - yc), -(x - xc))++    -- Partition the points into points that coincide with the center+    -- and points that do not.+    (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs++    -- All the points that coincide with the current center and succeed it+    -- in the (appropriately ordered) window stack.+    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr+             -- tail should be safe here because cur should be in onCtr++    -- All the points that do not coincide with the current center and which+    -- lie in the (rotated) right cone.+    offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr++    -- The off-center point closest to the center and+    -- closest to the bottom ray of the cone.  Nothing if no off-center+    -- point is in the cone+    closestOffCtr = if null offCtr' then Nothing+                                    else Just $ fst $ L.foldl1' closest offCtr'++    closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))+      | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p+      | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p+      | yq < yp                         = wq -- q is closer to the bottom ray than p+      | otherwise                       = wp -- q is farther away from the bottom ray than p+                                             -- or it has the same distance but comes later+                                             -- in the window stack++-- | Swaps the current window with the window given as argument+swap :: Window -> WindowSet -> WindowSet+swap win winset = W.focusWindow cur+                $ L.foldl' (flip W.focusWindow) newwinset newfocused+  where+    -- The current window+    cur      = fromJust $ W.peek winset++    -- All screens+    scrs     = W.screens winset++    -- All visible workspaces+    visws    = map W.workspace scrs++    -- The focused windows of the visible workspaces+    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws++    -- The window lists of the visible workspaces+    wins     = map (W.integrate' . W.stack) visws++    -- Update focused windows and window lists to reflect swap of windows.+    newfocused = map swapWins focused+    newwins    = map (map swapWins) wins++    -- Replaces the current window with the argument window and vice versa.+    swapWins x | x == cur  = win+               | x == win  = cur+               | otherwise = x++    -- Reconstruct the workspaces' window stacks to reflect the swap.+    newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins+    newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws+    newwinset = winset { W.current = head newscrs+                       , W.visible = tail newscrs+                       }++-- | Calculates the center of a rectangle+centerOf :: Rectangle -> (Position, Position)+centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)++-- | Shorthand for integer conversions+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++-- | Functions to choose the subset of windows to operate on+thisLayer, otherLayer :: a -> a -> a+thisLayer  = curry fst+otherLayer = curry snd++-- | Returns the list of visible workspaces and their screen rects+visibleWorkspaces :: WindowSet -> Bool -> [WSRect]+visibleWorkspaces winset wrap = addWrapping winset wrap+                              $ map ( \scr -> ( W.tag . W.workspace         $ scr+                                              , screenRect . W.screenDetail $ scr+                                              )+                                    )+                              $ sortedScreens winset++-- | Creates five copies of each (window/workspace, rect) pair in the input: the+-- original and four offset one desktop size (desktop = collection of all+-- screens) to the left, to the right, up, and down.  Wrap-around at desktop+-- edges is implemented by navigating into these displaced copies.+addWrapping :: WindowSet -- ^ The window set, used to get the desktop size+            -> Bool      -- ^ Should wrapping be used?  Do nothing if not.+            -> [Rect a]  -- ^ Input set of (window/workspace, rect) pairs+            -> [Rect a]+addWrapping _      False wrects = wrects+addWrapping winset True  wrects = [ (w, r { rect_x = rect_x r + fi x+                                          , rect_y = rect_y r + fi y+                                          }+                                    )+                                  | (w, r) <- wrects+                                  , (x, y)  <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]+                                  ]+  where+    (xoff, yoff) = wrapOffsets winset++-- | Calculates the offsets for window/screen coordinates for the duplication+-- of windows/workspaces that implements wrap-around.+wrapOffsets :: WindowSet -> (Integer, Integer)+wrapOffsets winset = (max_x - min_x, max_y - min_y)+  where+    min_x = fi $ minimum $ map rect_x rects+    min_y = fi $ minimum $ map rect_y rects+    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects+    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects+    rects = map snd $ visibleWorkspaces winset False+++-- | Returns the list of screens sorted primarily by their centers'+-- x-coordinates and secondarily by their y-coordinates.+sortedScreens :: WindowSet -> [Screen]+sortedScreens winset = L.sortBy cmp+                     $ W.screens winset+  where+    cmp s1 s2 | x1 < x2   = LT+              | x1 > x2   = GT+              | y1 < x2   = LT+              | y1 > y2   = GT+              | otherwise = EQ+      where+        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)+        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)+++-- | Calculates the L1-distance between two points.+lDist :: (Position, Position) -> (Position, Position) -> Int+lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)

@@ -41,7 +41,7 @@  Example usage in your @~\/.xmonad\/xmonad.hs@ file: -> import XMonad.Actions.PhysicalSCreens+> import XMonad.Actions.PhysicalScreens  > , ((modMask, xK_a), onPrevNeighbour W.view) > , ((modMask, xK_o), onNextNeighbour W.view)@@ -112,4 +112,3 @@ -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter. onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X () onPrevNeighbour = neighbourWindows (-1)-

@@ -110,7 +110,7 @@     (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->     X () plane function numberLines_ limits direction = do-    state <- get+    st <- get     xconf <- ask      numberLines <-@@ -205,7 +205,7 @@         preColumns = div areas numberLines          mCurrentWS :: Maybe Int-        mCurrentWS = elemIndex (currentTag $ windowset state) areaNames+        mCurrentWS = elemIndex (currentTag $ windowset st) areaNames          areas :: Int         areas = length areaNames

@@ -0,0 +1,116 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Actions.ShowText+-- Copyright   :  (c) Mario Pastorelli (2012)+-- License     :  BSD-style (see xmonad/LICENSE)+--+-- Maintainer  :  pastorelli.mario@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"+-- which offers more features (currently)+-----------------------------------------------------------------------------++module XMonad.Actions.ShowText+    ( -- * Usage+      -- $usage+      defaultSTConfig+    , handleTimerEvent+    , flashText+    , ShowTextConfig(..)+    ) where++import Control.Monad (when)+import Data.Map (Map,empty,insert,lookup)+import Data.Monoid (mempty, All)+import Prelude hiding (lookup)+import XMonad+import XMonad.StackSet (current,screen)+import XMonad.Util.Font (Align(AlignCenter)+                       , initXMF+                       , releaseXMF+                       , textExtentsXMF+                       , textWidthXMF)+import XMonad.Util.Timer (startTimer)+import XMonad.Util.XUtils (createNewWindow+                         , deleteWindow+                         , fi+                         , showWindow+                         , paintAndWrite)+import qualified XMonad.Util.ExtensibleState as ES++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.ShowText+--+-- Then add the event hook handler:+--+-- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }+--+-- You can then use flashText in your keybindings:+--+-- > ((modMask, xK_Right), flashText defaultSTConfig 1 "->" >> nextWS)+--++-- | ShowText contains the map with timers as keys and created windows as values+newtype ShowText = ShowText (Map Atom Window)+    deriving (Read,Show,Typeable)++instance ExtensionClass ShowText where+    initialValue = ShowText empty++-- | Utility to modify a ShowText+modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText+modShowText f (ShowText m) = ShowText $ f m++data ShowTextConfig =+    STC { st_font :: String -- ^ Font name+        , st_bg   :: String -- ^ Background color+        , st_fg   :: String -- ^ Foreground color+    }++defaultSTConfig :: ShowTextConfig+defaultSTConfig =+    STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"+        , st_bg   = "black"+        , st_fg   = "white"+    }++-- | Handles timer events that notify when a window should be removed+handleTimerEvent :: Event -> X All+handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do+    (ShowText m) <- ES.get :: X ShowText+    a <- io $ internAtom dis "XMONAD_TIMER" False+    when (mtyp == a && length d >= 1)+         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)+    mempty+handleTimerEvent _ = mempty++-- | Shows a window in the center of the screen with the given text+flashText :: ShowTextConfig+    -> Rational -- ^ number of seconds+    -> String -- ^ text to display+    -> X ()+flashText c i s = do+  f <- initXMF (st_font c)+  d <- asks display+  sc <- gets $ fi . screen . current . windowset+  width <- textWidthXMF d f s+  (as,ds) <- textExtentsXMF f s+  let hight = as + ds+      ht    = displayHeight d sc+      wh    = displayWidth d sc+      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 (st_bg c) ""+                (st_fg c) (st_bg c) [AlignCenter] [s]+  releaseXMF f+  io $ sync d False+  t <- startTimer i+  ES.modify $ modShowText (insert (fromIntegral t) w)

@@ -26,10 +26,9 @@                  TagPrompt,                  ) where -import Prelude hiding (catch) import Data.List (nub,sortBy) import Control.Monad-import Control.Exception+import Control.Exception as E  import XMonad.StackSet hiding (filter) @@ -82,7 +81,7 @@ --   reads from the \"_XMONAD_TAGS\" window property getTags :: Window -> X [String] getTags w = withDisplay $ \d ->-    io $ catch (internAtom d "_XMONAD_TAGS" False >>=+    io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=                 getTextProperty d w >>=                 wcTextPropertyToTextList d)                (econst [[]])

@@ -114,7 +114,7 @@    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"):+   (borrowing 'runInTerm' from "XMonad.Util.Run"):    > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt")) -}

@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- Module     :  XMonad.Actions.Workscreen+-- Copyright  :  (c) 2012 kedals0+-- License    :  BSD3-style (see LICENSE)+--+-- Maintainer :  Dal <kedasl0@gmail.com>+-- Stability  :  unstable+-- Portability:  unportable+--+-- A workscreen permits to display a set of workspaces on several+-- screens. In xinerama mode, when a workscreen is viewed, workspaces+-- associated to all screens are visible.+--+-- The first workspace of a workscreen is displayed on first screen,+-- second on second screen, etc. Workspace position can be easily+-- changed. If the current workscreen is called again, workspaces are+-- shifted.+--+-- This also permits to see all workspaces of a workscreen even if just+-- one screen is present, and to move windows from workspace to workscreen.+-----------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-}++module XMonad.Actions.Workscreen (+  -- * Usage+  -- $usage+  configWorkscreen+  ,viewWorkscreen+  ,Workscreen(..)+  ,shiftToWorkscreen+  ,fromWorkspace+  ,expandWorkspace+  ) where++import XMonad hiding (workspaces)+import qualified XMonad.StackSet as W+import qualified XMonad.Util.ExtensibleState as XS+import XMonad.Actions.OnScreen++-- $usage+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:+--+-- > import XMonad.Actions.Workscreen+-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]+-- >                in Workscreen.expandWorkspace 2 myOldWorkspaces+-- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)+-- >                    return ()+--+-- Then, replace normal workspace view and shift keybinding:+--+-- > [((m .|. modm, k), f i)+-- >      | (i, k) <- zip [0..] [1..12]+-- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]+--+-- For detailed instructions on editing your key bindings, see+-- "XMonad.Doc.Extending#Editing_key_bindings".+++data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)+type WorkscreenId=Int++data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)+instance ExtensionClass WorkscreenStorage where+  initialValue = WorkscreenStorage 0 []++-- | Helper to group workspaces. Multiply workspace by screens number.+expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]+expandWorkspace nscr ws = concat $ map expandId ws+  where expandId wsId = let t = wsId ++ "_"+                        in map ((++) t . show ) [1..nscr]++-- | Create workscreen list from workspace list. Group workspaces to+-- packets of screens number size.+fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]+fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)+fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]+fromWorkspace' _ [] = []+fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)++-- | Initial configuration of workscreens+configWorkscreen :: [Workscreen] -> X ()+configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn)++-- | View workscreen of index @WorkscreenId@. If current workscreen is asked+-- workscreen, workscreen's workspaces are shifted.+viewWorkscreen :: WorkscreenId -> X ()+viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get+                           let wscr = if wscrId == c+                                          then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)+                                          else a !! wscrId+                               (x,_:ys) = splitAt wscrId a+                               newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)+                           windows (viewWorkscreen' wscr)+                           XS.put newWorkscreenStorage++viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet+viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws)+  where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s++shiftWs :: [WorkspaceId] -> [WorkspaceId]+shiftWs a = drop 1 a ++ take 1 a++-- | Shift a window on the first workspace of workscreen+-- @WorkscreenId@.+shiftToWorkscreen :: WorkscreenId -> X ()+shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get+                              let ws = head . workspaces $ a !! wscrId+                              windows $ W.shift ws

@@ -175,7 +175,7 @@ * "XMonad.Actions.FloatKeys":     Move and resize floating windows. -* "XMonad.Layout.FloatSnap":+* "XMonad.Actions.FloatSnap":     Move and resize floating windows using other windows and the edge of the     screen as guidelines. @@ -257,7 +257,7 @@ * "XMonad.Actions.UpdateFocus":     Updates the focus on mouse move in unfocused windows. -* "XMonadContrib.UpdatePointer":+* "XMonad.Actions.UpdatePointer":     Causes the pointer to follow whichever window focus changes to.  * "XMonad.Actions.Warp":

@@ -0,0 +1,1254 @@+{-# LANGUAGE CPP, GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DebugEvents+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  allbery.b@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- Module to dump diagnostic information about X11 events received by+-- @xmonad@.  This is incomplete due to 'Event' being incomplete and not+-- providing information about a number of events, and enforcing artificial+-- constraints on others (for example 'ClientMessage'); the @X11@ package+-- will require a number of changes to fix these problems.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DebugEvents (debugEventsHook) where++import           Prelude++import           XMonad                               hiding (windowEvent+                                                             ,(-->)+                                                             )++import           XMonad.Hooks.DebugKeyEvents                 (debugKeyEvents)+import           XMonad.Util.DebugWindow                     (debugWindow)++-- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName)++import           Control.Exception.Extensible         as E+import           Control.Monad.State+import           Control.Monad.Reader+import           Data.Char                                   (isDigit)+import           Data.List                                   (genericIndex+                                                             ,genericLength+                                                             ,unfoldr+                                                             )+import           Codec.Binary.UTF8.String+import           Data.Maybe                                  (fromMaybe)+import           Data.Monoid+import           Foreign+import           Foreign.C.String+import           Foreign.C.Types+import           Numeric                                     (showHex)+import           System.Exit+import           System.IO+import           System.Process++-- this should move into X11+foreign import ccall unsafe "XGetAtomName"+  xGetAtomName :: Display -> Atom -> IO CString++getAtomName     :: Display -> Atom -> IO (Maybe String)+getAtomName d a =  do+  n <- xGetAtomName d a+  if n == nullPtr+    then return Nothing+    else do+      n' <- peekCString n+      xFree n+      return $ Just n'++-- | Event hook to dump all received events.  You should probably not use this+--   unconditionally; it will produce massive amounts of output.+debugEventsHook   :: Event -> X All+debugEventsHook e =  debugEventsHook' e >> return (All True)++-- | Dump an X11 event.  Can't be used directly as a 'handleEventHook'.+debugEventsHook' :: Event -> X ()++debugEventsHook' (ConfigureRequestEvent {ev_window       = w+                                        ,ev_parent       = p+                                        ,ev_x            = x+                                        ,ev_y            = y+                                        ,ev_width        = wid+                                        ,ev_height       = ht+                                        ,ev_border_width = bw+                                        ,ev_above        = above+                                        ,ev_detail       = place+                                        ,ev_value_mask   = msk+                                        }) = do+  windowEvent "ConfigureRequest" w+  windowEvent "  parent"         p+--  mask <- quickFormat msk $ dumpBits wmCRMask+--  say "  requested parameters" $ concat ['(':show wid+--                                        ,'x':show ht+--                                        ,')':if bw == 0 then "" else '+':show bw+--                                        ,'@':'(':show x+--                                        ,',':show y+--                                        ,") mask "+--                                        ,mask+--                                        ]+  s <- quickFormat [x,y,wid,ht,bw,fromIntegral above,place] $+       dumpListByMask' msk [("x"           ,dump32              ,cARDINAL)+                           ,("y"           ,dump32              ,cARDINAL)+                           ,("width"       ,dump32              ,cARDINAL)+                           ,("height"      ,dump32              ,cARDINAL)+                           ,("border_width",dump32              ,cARDINAL)+                           ,("sibling"     ,dumpWindow          ,wINDOW  )+                           ,("detail"      ,dumpEnum wmPlacement,cARDINAL)+                           ]+  say "  requested" s++debugEventsHook' (ConfigureEvent        {ev_window = w+                                        ,ev_above  = above+                                        }) = do+  windowEvent "Configure" w+  -- most of the content is covered by debugWindow+  when (above /= none) $ debugWindow above >>= say "  above"++debugEventsHook' (MapRequestEvent       {ev_window     = w+                                        ,ev_parent     = p+                                        }) =+  windowEvent "MapRequest" w >>+  windowEvent "  parent"   p++debugEventsHook' e@(KeyEvent {ev_event_type = t})+    | t == keyPress =+  io (hPutStr stderr "KeyPress ") >>+  debugKeyEvents e >>+  return ()++debugEventsHook' (ButtonEvent           {ev_window = w+                                        ,ev_state  = s+                                        ,ev_button = b+                                        }) = do+  windowEvent "Button" w+  nl <- gets numberlockMask+  let msk | s == 0    = ""+          | otherwise = "modifiers " ++ vmask nl s+  say "  button" $ show b ++ msk++debugEventsHook' (DestroyWindowEvent    {ev_window = w+                                        }) =+  windowEvent "DestroyWindow" w++debugEventsHook' (UnmapEvent            {ev_window = w+                                        }) =+  windowEvent "Unmap" w++debugEventsHook' (MapNotifyEvent        {ev_window = w+                                        }) =+  windowEvent "MapNotify" w++{- way too much output; suppressed.++debugEventsHook' (CrossingEvent         {ev_window    = w+                                        ,ev_subwindow = s+                                        }) =+  windowEvent "Crossing"    w >>+  windowEvent "  subwindow" s+-}+debugEventsHook' (CrossingEvent         {}) =+  return ()++debugEventsHook' (SelectionRequest      {ev_requestor = rw+                                        ,ev_owner     = ow+                                        ,ev_selection = a+                                        }) =+  windowEvent "SelectionRequest" rw >>+  windowEvent "  owner"          ow >>+  atomEvent   "  atom"           a++debugEventsHook' (PropertyEvent         {ev_window    = w+                                        ,ev_atom      = a+                                        ,ev_propstate = s+                                        }) = do+  a' <- atomName a+  -- too many of these, and they're not real useful+  if a' `elem` ["_NET_WM_USER_TIME"+--               ,"_NET_WM_WINDOW_OPACITY"+               ] then return () else do+  windowEvent "Property on" w+  s' <- case s of+          1 -> return "deleted"+          0 -> dumpProperty a a' w (7 + length a')+          _ -> error "Illegal propState; Xlib corrupted?"+  say "  atom" $ a' ++ s'++debugEventsHook' (ExposeEvent           {ev_window = w+                                        }) =+  windowEvent "Expose" w++debugEventsHook' (ClientMessageEvent    {ev_window       = w+                                        ,ev_message_type = a+                                        -- @@@ they did it again!  no ev_format,+                                        --     and ev_data is [CInt]+                                        -- @@@ and get a load of the trainwreck+                                        --     that is setClientMessageEvent!+--                                        ,ev_format       = b+                                        ,ev_data         = vs'+                                        }) = do+  windowEvent "ClientMessage on" w+  n <- atomName a+  -- this is a sort of custom property+  -- @@@ this likely won't work as is; type information varies, I think+  (ta,b,l) <- case lookup n clientMessages of+                Nothing        -> return (a,32,length vs')+                Just (ta',b,l) -> do+                  ta <- getAtom ta'+                  return (ta,b,l)+  let wl = bytes b+  vs <- io $ take (l * wl) `fmap` splitCInt vs'+  s <- dumpProperty' w a n ta b vs 0 (10 + length n)+  say "  message" $ n ++ s++debugEventsHook' _                      = return ()++-- | Emit information about an atom.+atomName   :: Atom -> X String+atomName a =  withDisplay $ \d ->+  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a++-- | Emit an atom with respect to the current event.+atomEvent     :: String -> Atom -> X ()+atomEvent l a =  atomName a >>= say l++-- | Emit a window with respect to the current event.+windowEvent     :: String -> Window -> X ()+windowEvent l w =  debugWindow w >>= say l++-- | Helper to emit tagged event information.+say     :: String -> String -> X ()+say l s =  trace $ l ++ ' ':s++-- | Deconstuct a list of 'CInt's into raw bytes+splitCInt    :: [CInt] -> IO Raw+splitCInt vs =  io $ withArray vs $ \p ->+                peekArray (4 * length vs) (castPtr p :: Ptr CUChar)++-- | Specify how to decode some common client messages.+clientMessages :: [(String,(String,Int,Int))]+clientMessages =  [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))+                  ,("WM_CHANGE_STATE"   ,("WM_STATE"          ,32,2))+                  ,("WM_COMMAND"        ,("STRING"            , 8,0))+                  ,("WM_SAVE_YOURSELF"  ,("STRING"            , 8,0))+                  ]++-- | Convert a modifier mask into a useful string+vmask                 :: KeyMask -> KeyMask -> String+vmask numLockMask msk =  unwords $+                         reverse $+                         fst     $+                         foldr vmask' ([],msk) masks+    where+      masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] +++              [(numLockMask,"num"  )+              ,(   lockMask,"lock" )+              ,(controlMask,"ctrl" )+              ,(  shiftMask,"shift")+              ,(   mod5Mask,"mod5" )+              ,(   mod4Mask,"mod4" )+              ,(   mod3Mask,"mod3" )+              ,(   mod2Mask,"mod2" )+              ,(   mod1Mask,"mod1" )+              ]+      vmask'   _   a@( _,0)                = a+      vmask' (m,s)   (ss,v) | v .&. m == m = (s : ss,v .&. complement m)+      vmask'   _        r                  = r++-- formatting properties.  ick. --++-- @@@ Document the parser.  Someday.++type Raw     = [CUChar]++data Decode = Decode {property :: Atom          -- original property atom+                     ,pName    :: String        -- its name+                     ,pType    :: Atom          -- base property type atom+                     ,width    :: Int           -- declared data width+                     ,window   :: Window        -- source window+                     ,indent   :: Int           -- current indent (via local)+                     ,limit    :: Int           -- line length+                     }++-- the result accumulates here mainly for the benefit of the indenter+data DecodeState = DecS {value :: Raw           -- unconsumed raw property value+                        ,accum :: String        -- output accumulator+                        ,joint :: String        -- separator when adding to accumulator+                        }++newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)+#ifndef __HADDOCK__+    deriving (Functor+             ,Monad+             ,MonadIO+             ,MonadState  DecodeState+             ,MonadReader Decode+             )+#endif++-- | Retrive, parse, and dump a window property.  As all the high-level property+--   interfaces lose information necessary to decode properties correctly, we +--   work at the lowest level available.+dumpProperty          :: Atom -> String -> Window -> Int -> X String+dumpProperty a n w i  =  do+  prop <- withDisplay $ \d ->+    io     $+    alloca $ \fmtp ->+    alloca $ \szp  ->+    alloca $ \lenp ->+    alloca $ \ackp ->+    alloca $ \vsp  -> do+    rc   <- xGetWindowProperty+              d+              w+              a+              0+              maxBound+              False+              anyPropertyType+              fmtp+              szp+              lenp+              ackp+              vsp+    case rc of+      0 -> do+        fmt <- fromIntegral `fmap` peek fmtp+        vs' <-                     peek vsp+        sz  <- fromIntegral `fmap` peek szp+        case () of+          () | fmt == none     -> xFree vs' >> return (Left   "(property deleted)"   )+             | sz < 0          -> xFree vs' >> return (Left $ "(illegal bit size " +++                                                              show sz              +++                                                              ")"                    )+             | sz `mod` 8 /= 0 -> xFree vs' >> return (Left $ "(illegal bit size " +++                                                              show sz              +++                                                              ")"                    )+             | otherwise       -> do+                 len <- fromIntegral `fmap` peek lenp+                 -- that's as in "ack! it's fugged!"+                 ack <- fromIntegral `fmap` peek ackp+                 vs <- peekArray (len * bytes sz) vs'+                 _ <- xFree vs'+                 return $ Right (fmt,sz,ack,vs)+      e -> return $ Left $ "getWindowProperty failed: " ++ show e+  case prop of+    Left  _               -> return ""+    Right (fmt,sz,ack,vs) -> dumpProperty' w a n fmt sz vs ack i++-- @@@ am I better off passing in the Decode and DecodeState?+-- | Parse and dump a property (or a 'ClientMessage').+dumpProperty'                             :: Window -- source window+                                          -> Atom   -- property id+                                          -> String -- property name+                                          -> Atom   -- property type+                                          -> Int    -- bit width+                                          -> Raw    -- raw value+                                          -> CULong -- size of un-dumped content+                                          -> Int    -- indent for output formatting+                                          -> X String+dumpProperty' w a n fmt sz vs ack i =  do+  ptn <- atomName fmt+  let dec  = Decode {property = a+                    ,pName    = n+                    ,pType    = fmt+                    ,width    = sz+                    ,indent   = i + length ptn + 6+                    ,window   = w+                    ,limit    = 96+                    }+      dec' = dec    {pType    = cARDINAL+                    ,width    = 8+                    }+      ds   = DecS   {value    = vs+                    -- @@@ probably should push this outside, since it doesn't+                    --     make sense for ClientMessage+                    ,accum    = " (" ++ ptn ++ ") "+                    ,joint    = "= "+                    }+  (_,ds') <- runDecode dec ds $ dumpProp a n+  let fin = length (value ds')+      len = length vs+      lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes"+      unk = case () of+              () | fin == len -> "undecodeable "+                 | fin == 0   -> "."+                 | otherwise  -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"+  (_,ds'') <- if fin == 0+              then return (True,ds')+              else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8+  (_,ds''') <- if ack == 0+               then return (True,ds'')+               else runDecode dec' (withJoint' " " ds'') $ propSimple lost -- @@@+  return $ accum ds'''++-- | A simplified version of 'dumpProperty\'', to format random values from+--   events.+quickFormat     :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String+quickFormat v f =  do+  let vl = length v+  vs <- io $+        allocaArray vl $+        \p -> pokeArray p (map fromIntegral v :: [CULong]) >>+              peekArray (4 * vl) (castPtr p :: Ptr CUChar)+  let dec = Decode {property = none+                   ,pName    = ""+                   ,pType    = cARDINAL+                   ,width    = 32+                   ,indent   = 0+                   ,window   = none+                   ,limit    = maxBound+                   }+      ds  = DecS   {value    = vs+                   ,accum    = ""+                   ,joint    = ""+                   }+  (r,ds') <- runDecode dec ds f+  return $ accum ds' ++ if r then "" else "?"++-- | Launch a decoding parser, returning success and final state.+runDecode                 :: Decode -> DecodeState -> Decoder Bool -> X (Bool,DecodeState)+runDecode c s (Decoder p) =  runStateT (runReaderT p c) s++-- Coerce bit size to bytes.+bytes   :: Int -> Int+bytes w =  w `div` 8++-- | The top level property decoder, for a wide variety of standard ICCCM and +--   EWMH window properties.  We pass part of the 'ReaderT' as arguments for +--   pattern matching.+dumpProp                                              :: Atom -> String -> Decoder Bool++dumpProp _ "CLIPBOARD"                                =  dumpSelection+dumpProp _ "_NET_SUPPORTED"                           =  dumpArray dumpAtom+dumpProp _ "_NET_CLIENT_LIST"                         =  dumpArray dumpWindow+dumpProp _ "_NET_CLIENT_LIST_STACKING"                =  dumpArray dumpWindow+dumpProp _ "_NET_NUMBER_OF_DESKTOPS"                  =  dump32+dumpProp _ "_NET_VIRTUAL_ROOTS"                       =  dumpArray dumpWindow+dumpProp _ "_NET_DESKTOP_GEOMETRY"                    =  dumpArray dump32+dumpProp _ "_NET_DESKTOP_VIEWPORT"                    =  dumpList [("w",dump32)+                                                                  ,("h",dump32)+                                                                  ]+dumpProp _ "_NET_CURRENT_DESKTOP"                     =  dump32+dumpProp _ "_NET_DESKTOP_NAMES"                       =  dumpArray dumpUTF+dumpProp _ "_NET_ACTIVE_WINDOW"                       =  dumpActiveWindow+dumpProp _ "_NET_WORKAREA"                            =  dumpList [("start"+                                                                   ,dumpList [("x",dump32)+                                                                             ,("y",dump32)+                                                                             ]+                                                                   )+                                                                  ,("size"+                                                                   ,dumpList [("w",dump32)+                                                                             ,("h",dump32)+                                                                             ]+                                                                   )+                                                                  ]+dumpProp _ "_NET_SUPPORTING_WM_CHECK"                 =  dumpWindow+dumpProp _ "_NET_DESKTOP_LAYOUT"                      =  dumpList [("orientation"+                                                                   ,dumpEnum nwmOrientation+                                                                   )+                                                                  ,("size"+                                                                   ,dumpList [("cols",dump32)+                                                                             ,("rows",dump32)+                                                                             ]+                                                                   )+                                                                  ,("origin"+                                                                   ,dumpEnum nwmOrigin+                                                                   )+                                                                  ]+dumpProp _ "_NET_SHOWING_DESKTOP"                     =  dump32+dumpProp _ "_NET_WM_NAME"                             =  dumpUTF+dumpProp _ "_NET_WM_VISIBLE_NAME"                     =  dumpUTF+dumpProp _ "_NET_WM_ICON_NAME"                        =  dumpUTF+dumpProp _ "_NET_WM_VISIBLE_ICON_NAME"                =  dumpUTF+dumpProp _ "_NET_WM_DESKTOP"                          =  dumpExcept [(0xFFFFFFFF,"all")]+                                                                    dump32+dumpProp _ "_NET_WM_WINDOW_TYPE"                      =  dumpArray dumpAtom+dumpProp _ "_NET_WM_STATE"                            =  dumpArray dumpAtom+dumpProp _ "_NET_WM_ALLOWED_ACTIONS"                  =  dumpArray dumpAtom+dumpProp _ "_NET_WM_STRUT"                            =  dumpList [("left gap"  ,dump32)+                                                                  ,("right gap" ,dump32)+                                                                  ,("top gap"   ,dump32)+                                                                  ,("bottom gap",dump32)+                                                                  ]+dumpProp _ "_NET_WM_STRUT_PARTIAL"                    =  dumpList [("left gap"    ,dump32)+                                                                  ,("right gap"   ,dump32)+                                                                  ,("top gap"     ,dump32)+                                                                  ,("bottom gap"  ,dump32)+                                                                  ,("left start"  ,dump32)+                                                                  ,("left end"    ,dump32)+                                                                  ,("right start" ,dump32)+                                                                  ,("right end"   ,dump32)+                                                                  ,("top start"   ,dump32)+                                                                  ,("top end"     ,dump32)+                                                                  ,("bottom start",dump32)+                                                                  ,("bottom end"  ,dump32)+                                                                  ]+dumpProp _ "_NET_WM_ICON_GEOMETRY"                    =  dumpList [("x",dump32)+                                                                  ,("y",dump32)+                                                                  ,("w",dump32)+                                                                  ,("h",dump32)+                                                                  ]+-- no, I'm not going to duplicate xprop *completely*!+dumpProp _ "_NET_WM_ICON"                             =  propSimple "(icon)"+dumpProp _ "_NET_WM_PID"                              =  dumpPid+dumpProp _ "_NET_WM_HANDLED_ICONS"                    =  propSimple "(defined)"+dumpProp _ "_NET_WM_USER_TIME"                        =  dumpExcept [(0,"do not map initially")]+                                                                    dumpTime+dumpProp _ "_NET_FRAME_EXTENTS"                       =  dumpList [("left"  ,dump32)+                                                                  ,("right" ,dump32)+                                                                  ,("top"   ,dump32)+                                                                  ,("bottom",dump32)+                                                                  ]+dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER"             =  dumpExcept [(0,"illegal value 0")]+                                                                    dump64+dumpProp _ "_NET_STARTUP_ID"                          =  dumpUTF+dumpProp _ "WM_PROTOCOLS"                             =  dumpArray dumpAtom+dumpProp _ "WM_COLORMAP_WINDOWS"                      =  dumpArray dumpWindow+dumpProp _ "WM_STATE"                                 =  dumpState+dumpProp _ "WM_LOCALE_NAME"                           =  dumpString+dumpProp _ "WM_CLIENT_LEADER"                         =  dumpWindow+dumpProp _ "_NET_WM_WINDOW_OPACITY"                   =  dumpPercent+dumpProp _ "XdndAware"                                =  dumpArray dumpAtom+dumpProp _ "_XKLAVIER_TRANSPARENT"                    =  dumpInteger 32+dumpProp _ "_XKLAVIER_STATE"                          =  dumpList [("state"     ,dumpInteger 32)+                                                                  ,("indicators",dumpXKlInds)+                                                                  ]+dumpProp _ "_MOTIF_DRAG_RECEIVER_INFO"                =  dumpMotifDragReceiver+dumpProp _ "_OL_WIN_ATTR"                             =  dumpOLAttrs+dumpProp _ "_OL_DECOR_ADD"                            =  dumpArray dumpAtom+dumpProp _ "_OL_DECOR_DEL"                            =  dumpArray dumpAtom+dumpProp _ "_MOTIF_WM_HINTS"                          =  dumpMwmHints+dumpProp _ "_MOTIF_WM_INFO"                           =  dumpMwmInfo+dumpProp _ "_XMONAD_DECORATED_BY"                     =  dumpWindow+dumpProp _ "_XMONAD_DECORATION_FOR"                   =  dumpWindow+dumpProp a _ | a == wM_NAME                           =  dumpString+             | a == pRIMARY                           =  dumpSelection+             | a == sECONDARY                         =  dumpSelection+               -- this is gross+             | a == wM_TRANSIENT_FOR                  =  do+                 root <- fromIntegral `fmap` inX (asks theRoot)+                 w <- asks window+                 WMHints {wmh_window_group = group} <-+                   inX $ asks display >>= io . flip getWMHints w+                 dumpExcept [(0   ,"window group " ++ show group)+                            ,(root,"window group " ++ show group)+                            ]+                            dumpWindow+             | a == rESOURCE_MANAGER                  =  dumpString+             | a == wM_COMMAND                        =  dumpString+             | a == wM_HINTS                          =  dumpWmHints+             | a == wM_CLIENT_MACHINE                 =  dumpString+             | a == wM_ICON_NAME                      =  dumpString+             | a == wM_ICON_SIZE                      =  dumpList [("min size"+                                                                   ,dumpList [("w",dump32)+                                                                             ,("h",dump32)+                                                                             ]+                                                                   )+                                                                  ,("max size"+                                                                   ,dumpList [("w",dump32)+                                                                             ,("h",dump32)+                                                                             ]+                                                                   )+                                                                  ,("increment"+                                                                   ,dumpList [("w",dump32)+                                                                             ,("h",dump32)+                                                                             ]+                                                                   )+                                                                  ]+             | a == wM_NORMAL_HINTS                   =  (...)+             | a == wM_ZOOM_HINTS                     =  (...) -- same as previous+             | a == rGB_DEFAULT_MAP                   =  (...) -- XStandardColormap+             | a == rGB_BEST_MAP                      =  (...) -- "+             | a == rGB_RED_MAP                       =  (...) -- "+             | a == rGB_GREEN_MAP                     =  (...) -- "+             | a == rGB_BLUE_MAP                      =  (...) -- "+             | a == rGB_GRAY_MAP                      =  (...) -- "+             | a == wM_CLASS                          =  dumpList [("name" ,dumpString)+                                                                  ,("class",dumpString)+                                                                  ]+dumpProp _ s | s `isCountOf` "WM_S"                   =  dumpSelection+             | s `isCountOf` "_NET_WM_CM_S"           =  dumpSelection+             | s `isCountOf` "_NET_DESKTOP_LAYOUT_S"  =  dumpSelection+             | s `isCountOf` "CUT_BUFFER"             =  dumpString+             -- and dumpProperties does the rest+             | otherwise                              =  return False++-- lower level decoders --++-- alter the current joint+withJoint   :: String -> Decoder a -> Decoder a+withJoint j =  ((modify $ withJoint' j) >>)++withJoint'     :: String -> DecodeState -> DecodeState+withJoint' j s =  s {joint = j}++-- lift an X into a Decoder+inX :: X a -> Decoder a+inX =  Decoder . lift . lift++-- flip isPrefixOf, but the remainder must be all digits+isCountOf         :: String -> String -> Bool+-- note that \NUL is safe because atom names have to be C strings+s `isCountOf` pfx =  null                     $+                     dropWhile isDigit        $+                     map fst                  $+                     dropWhile (uncurry (==)) $+                     zip s                    $+                     pfx ++ repeat '\NUL'++-- localize an increased indent+withIndent   :: Int -> Decoder a -> Decoder a+withIndent w =  local (\r -> r {indent = indent r + w})++-- dump an array of items.  this dumps the entire property+dumpArray      :: Decoder Bool -> Decoder Bool+dumpArray item =  do+  withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "")++-- step through values as an array, ending on parse error or end of list+dumpArray'          :: Decoder Bool -> String -> Decoder Bool+dumpArray' item pfx =  do+  vs <- gets value+  if vs == []+    then append "]"+    else append pfx >> whenD item (dumpArray' item ",")++-- keep parsing until a parse step fails+-- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when',+--     which suggests that 'whenX' is *also* the same function... yep.  ISAGN+whenD     :: Monad m => m Bool -> m Bool -> m Bool+whenD p f =  p >>= \b -> if b then f else return False++-- verify a decoder parameter, else call error reporter+-- once again, it's more general than I originally wrote+guardR                  :: (MonadReader r m, Eq v)+                        => (r -> v)                -- value selector+                        -> v                       -- expected value+                        -> (v -> v -> m a)         -- error reporter+                        -> m a                     -- continuation (hush)+                        -> m a+guardR sel val err good =  do+  v <- asks sel+  if v == val then good else err v val++-- this is kinda dumb+fi       :: Bool -> a -> a -> a+fi p n y =  if p then y else n -- flip (if' p), if that existed++-- verify we have the expected word size+guardSize      :: Int -> Decoder Bool -> Decoder Bool+-- see XSync documentation for this insanity+guardSize 64 =  guardR width 32 propSizeErr . guardSize' 8         propShortErr+guardSize  w =  guardR width  w propSizeErr . guardSize' (bytes w) propShortErr++guardSize'       :: Int -> Decoder a -> Decoder a -> Decoder a+guardSize' l n y =  gets value >>= \vs -> fi (length vs >= l) n y++-- verify we have the expected property type+guardType    :: Atom -> Decoder Bool -> Decoder Bool+guardType  t =  guardR pType t propTypeErr++-- dump a structure as a named tuple+dumpList       :: [(String,Decoder Bool)] -> Decoder Bool+dumpList proto =  do+  a <- asks pType+  dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "("++-- same but elements have their own distinct types+dumpList'       :: [(String,Decoder Bool,Atom)] -> Decoder Bool+dumpList' proto =  dumpList'' (maxBound :: CULong) proto "("++-- same but only dump elements identified by provided mask+dumpListByMask     :: CULong -> [(String,Decoder Bool)] -> Decoder Bool+dumpListByMask m p =  do+  a <- asks pType+  dumpList'' m (map (\(s,d) -> (s,d,a)) p) "("++-- and the previous two combined+dumpListByMask'     :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool+dumpListByMask' m p =  dumpList'' m p "("++dumpList''                    :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool+dumpList'' _ []           _   =  append ")" >> return True+dumpList'' 0 _            _   =  append ")" >> return True+dumpList'' m ((l,p,t):ps) sep = do+  (e,sep') <- if m .&. 1 == 0+              then do+                -- @@@ ew+                st <- get+                e <- local (\r -> r {pType = t}) p+                v' <- gets value+                put $ st {value = v'}+                return (e,sep)+              else do+                let label = sep ++ l ++ " = "+                append label+                e <- withJoint "" $ do+                       local (\r -> r {pType  = t+                                      ,indent = indent r + length label+                                      })+                             p+                return (e,",")+  if e then dumpList'' (m `shiftR` 1) ps sep' else return e++-- do the getTextProperty dance, the hard way.+-- @@@ @COMPOUND_TEXT@ not supported yet.+dumpString :: Decoder Bool+dumpString =  do+  fmt <- asks pType+  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]+  case () of+    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)+       | fmt == sTRING        -> guardSize  8 $ do+                                   vs <- gets value+                                   modify (\r -> r {value = []})+                                   let ss = flip unfoldr (map twiddle vs) $+                                            \s -> if null s+                                                  then Nothing+                                                  else let (w,s'') = break (== '\NUL') s+                                                           s'      = if null s''+                                                                     then s''+                                                                     else tail s''+                                                        in Just (w,s')+                                   case ss of+                                     [s] -> append $ show s+                                     ss' -> let go (s:ss'') c = append c        >>+                                                                append (show s) >>+                                                                go ss'' ","+                                                go []       _ = append "]"+                                             in append "[" >> go ss' ""+       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)+       | otherwise            -> (inX $ atomName fmt) >>=+                                 failure . ("unrecognized string type " ++)++-- show who owns a selection+dumpSelection :: Decoder Bool+dumpSelection =  do+  -- system selections contain a window ID; others are random+  -- note that the window ID will be the same as the owner, so+  -- we don't really care anyway.  we *do* want the selection owner+  a <- asks property+  owner <- inX $ withDisplay $ \d -> io $ xGetSelectionOwner d a+  if owner == none+    then append "unowned"+    else do+      w <- inX $ debugWindow owner+      append $ "owned by " ++ w++-- for now, not querying Xkb+dumpXKlInds :: Decoder Bool+dumpXKlInds =  guardType iNTEGER $ do+                 n <- fmap fromIntegral `fmap` getInt' 32+                 case n of+                   Nothing -> propShortErr+                   Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])+  where+    dumpInds                               :: Word32 -> Word32 -> Int -> [String] -> [String]+    dumpInds n bt c bs | n == 0 && c == 1 =  ["none"]+                       | n == 0           =  bs+                       | n .&. bt /= 0    =  dumpInds (n .&. complement bt)+                                                      (bt `shiftL` 1)+                                                      (c + 1)+                                                      ((show c):bs)+                       | otherwise        =  dumpInds n+                                                      (bt `shiftL` 1)+                                                      (c + 1)+                                                      bs++-- decode an Atom+dumpAtom :: Decoder Bool+dumpAtom =+  guardType aTOM $ do+  a <- getInt' 32+  case a of+    Nothing -> return False+    Just a' -> do+           an <- inX $ atomName $ fromIntegral a'+           append an++dumpWindow :: Decoder Bool+dumpWindow =  guardSize 32 $ guardType wINDOW $ do+                w <- getInt' 32+                case w of+                  Nothing -> return False+                  Just w' -> inX (debugWindow (fromIntegral w')) >>= append++-- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list+dumpActiveWindow :: Decoder Bool+dumpActiveWindow =  guardSize 32 $ do+                      t <- asks pType+                      nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW"+                      case () of+                        () | t == wINDOW -> dumpWindow+                           | t == nAW    -> dumpList' [("source"       ,dumpEnum awSource,cARDINAL)+                                                      ,("timestamp"    ,dumpTime         ,cARDINAL)+                                                      ,("active window",dumpWindow       ,wINDOW  )+                                                      ]+                        _                -> do+                                     t' <- inX $ atomName t+                                     failure $ concat ["(bad type "+                                                      ,t'+                                                      ,"; expected WINDOW or _NET_ACTIVE_WINDOW"+                                                      ]+-- dump a generic CARDINAL value+dumpInt   :: Int -> Decoder Bool+dumpInt w =  guardSize w $ guardType cARDINAL $ getInt w show++-- INTEGER is the signed version of CARDINAL+dumpInteger   :: Int -> Decoder Bool+dumpInteger w =  guardSize w $ guardType iNTEGER $ getInt w (show . signed w)++-- reinterpret an unsigned as a signed+signed     :: Int -> Integer -> Integer+signed w i =  bit (w + 1) - i++-- and wrappers to keep the parse list in bounds+dump64 :: Decoder Bool+dump64 =  dumpInt 64++dump32 :: Decoder Bool+dump32 =  dumpInt 32++{- not used in standard properties+dump16 :: Decoder Bool+dump16 =  dumpInt 16+-}++dump8 :: Decoder Bool+dump8 =  dumpInt 8++-- I am assuming for the moment that this is a single string.+-- This might be false; consider the way the STRING properties+-- handle lists.+dumpUTF :: Decoder Bool+dumpUTF =  do+  uTF8_STRING <- inX $ getAtom "UTF8_STRING"+  guardType uTF8_STRING $ guardSize 8 $ do+  s <- gets value+  modify (\r -> r {value = []})+  append . show . decode . map fromIntegral $ s+  return True++-- dump an enumerated value using a translation table+dumpEnum'        :: [String] -> Atom -> Decoder Bool+dumpEnum' ss fmt =  guardType fmt $+                    getInt 32     $+                    \r -> case () of+                            () | r < 0                 -> "undefined value " ++ show r+                               | r >= genericLength ss -> "undefined value " ++ show r+                               | otherwise             -> genericIndex ss r++-- we do not, unlike @xev@, try to ascii-art pixmaps.+dumpPixmap :: Decoder Bool+dumpPixmap =  guardType pIXMAP $ do+                p' <- getInt' 32+                case p' of+                  Nothing -> return False+                  Just p  -> do+                    append $ "pixmap " ++ showHex p ""+                    g' <- inX $ withDisplay $ \d -> io $+                            Just `fmap` getGeometry d (fromIntegral p)+                            `E.catch`+                            \e -> case fromException e of+                                    Just x -> throw e `const` (x `asTypeOf` ExitSuccess)+                                    _      -> return Nothing+                    case g' of+                      Nothing                   -> append " (deleted)"+                      Just (_,x,y,wid,ht,bw,dp) ->+                          append $ concat+                                     [" ("+                                     ,show wid+                                     ,'x':show ht+                                     ,'x':show dp+                                     ,')':if bw == 0 then "" else '+':show bw+                                     ,"@("+                                     ,show x+                                     ,',':show y+                                     ,")"+                                     ]++dumpOLAttrs :: Decoder Bool+dumpOLAttrs = do+  pt <- inX $ getAtom "_OL_WIN_ATTR"+  guardType pt $ do+    msk <- getInt' 32+    case msk of+      Nothing   -> propShortErr+      Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom     )+                                                      ,("menu"        ,dump32       ) -- @@@ unk+                                                      ,("pushpin"     ,dumpEnum bool)+                                                      ,("limited menu",dump32       ) -- @@@ unk+                                                      ]++dumpMwmHints :: Decoder Bool+dumpMwmHints =  do+  ta <- asks property+  guardType ta $ do+    msk <- getInt' 32+    case msk of+      Nothing   -> propShortErr+      Just msk' -> dumpListByMask (fromIntegral msk') [("functions"  ,dumpBits mwmFuncs    )+                                                      ,("decorations",dumpBits mwmDecos    )+                                                      ,("input mode" ,dumpEnum mwmInputMode)+                                                      ,("status"     ,dumpBits mwmState    )+                                                      ]++dumpMwmInfo :: Decoder Bool+dumpMwmInfo =  do+  ta <- asks property+  guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL)+                           ,("window",dumpWindow       ,wINDOW  )+                           ]+             +-- the most common case+dumpEnum    :: [String] -> Decoder Bool+dumpEnum ss =  dumpEnum' ss cARDINAL++-- implement exceptional cases atop a normal dumper+-- @@@ there's gotta be a better way+dumpExcept           :: [(Integer,String)] -> Decoder Bool -> Decoder Bool+dumpExcept xs item = do+  -- this horror brought to you by reparsing to get the right value for our use+  sp <- get+  rc <- item+  if not rc then return False else do+    that <- get -- if none match then we just restore the value parse+    vs <- gets value+    let w = (length (value sp) - length vs) * 8+    -- now we get to reparse again so we get our copy of it+    put sp+    Just v <- getInt' w+    -- and after all that, we can process the exception list+    dumpExcept' xs that v++dumpExcept'                                      :: [(Integer,String)]+                                                 -> DecodeState+                                                 -> Integer+                                                 -> Decoder Bool+dumpExcept' []             that _                =  put that >> return True+dumpExcept' ((exc,str):xs) that val | exc == val =  append str+                                    | otherwise  =  dumpExcept' xs that val++-- use @ps@ to get process information.+-- @@@@ assumes a POSIX @ps@, not a BSDish one.+dumpPid :: Decoder Bool+dumpPid =  guardType cARDINAL $ do+             n <- getInt' 32+             case n of+               Nothing   -> return False+               Just pid' -> do+                      let pid = show pid'+                          ps  = (proc "/bin/ps" ["-fp" ++ pid]) {std_out = CreatePipe}+                      (_,o,_,_) <- io $ createProcess ps+                      case o of+                        Nothing -> append $ "pid " ++ pid+                        Just p' -> do+                                  prc <- io $ lines `fmap` hGetContents p'+                                  -- deliberately forcing it+                                  append $ if length prc < 2+                                           then "pid " ++ pid+                                           else prc !! 1++dumpTime :: Decoder Bool+dumpTime =  append "server event # " >> dump32++dumpState :: Decoder Bool+dumpState =  do+  wM_STATE <- inX $ getAtom "WM_STATE"+  guardType wM_STATE $ dumpList' [("state"      ,dumpEnum wmState,cARDINAL)+                                 ,("icon window",dumpWindow      ,wINDOW  )+                                 ]++dumpMotifDragReceiver :: Decoder Bool+dumpMotifDragReceiver =  do+  ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO"+  guardType ta $ dumpList' [("endian"    ,dumpMotifEndian,cARDINAL)+                           ,("version"   ,dump8          ,cARDINAL)+                           ,("style"     ,dumpMDropStyle ,cARDINAL) -- @@@ dummy+                           ]++dumpMDropStyle :: Decoder Bool+dumpMDropStyle =  do+  d <- getInt' 8+  pad 1 $ case d of+            Nothing             -> propShortErr+            Just ps | ps == 0   -> pad 12 $ append "none"+                    | ps == 1   -> pad 12 $ append "drop only"+                    | ps == 2   ->          append "prefer preregister " >> dumpMDPrereg+                    | ps == 3   ->          append "preregister "        >> dumpMDPrereg+                    | ps == 4   -> pad 12 $ append "prefer dynamic"+                    | ps == 5   -> pad 12 $ append "dynamic"+                    | ps == 6   -> pad 12 $ append "prefer receiver"+                    | otherwise -> failure $ "unknown drop style " ++ show ps++dumpMDPrereg :: Decoder Bool+dumpMDPrereg =  do+  -- this is a bit ugly; we pretend to be extending the above dumpList'+  append ","+  append "proxy window = "+  withIndent 15 dumpWindow+  append ","+  append "drop sites = "+  dsc' <- getInt' 16+  case dsc' of+    Nothing  -> propShortErr+    Just dsc -> do+      withIndent 13 $ append (show dsc)+      pad 2 $ do+        append ","+        append "total size = "+        withIndent 13 dump32+        dumpMDBlocks $ fromIntegral dsc+    +dumpMDBlocks   :: Int -> Decoder Bool+dumpMDBlocks _ =  propSimple "(drop site info)" -- @@@ maybe later if needed++dumpMotifEndian :: Decoder Bool+dumpMotifEndian =  guardType cARDINAL $ guardSize 8 $ do+  c <- map twiddle `fmap` eat 1+  case c of+    ['l'] -> append "little"+    ['B'] -> append "big"+    _     -> failure "bad endian flag"++pad     :: Int -> Decoder Bool -> Decoder Bool+pad n p =  do+  vs <- gets value+  if length vs < n+    then propShortErr+    else modify (\r -> r {value = drop n vs}) >> p++dumpPercent :: Decoder Bool+dumpPercent =  guardType cARDINAL $ do+                 n <- getInt' 32+                 case n of+                   Nothing -> return False+                   Just n' -> +                       let pct = 100 * fromIntegral n' / fromIntegral (maxBound :: Word32)+                           pct :: Double+                        in append $ show (round pct :: Integer) ++ "%"++dumpWmHints :: Decoder Bool+dumpWmHints =+  guardType wM_HINTS $ do+  msk <- getInt' 32+  case msk of+    Nothing   -> return False+    Just msk' -> dumpListByMask' (fromIntegral msk')+                                 [("input"        ,dumpEnum bool   ,cARDINAL)+                                 ,("initial_state",dumpEnum wmState,cARDINAL)+                                 ,("icon_pixmap"  ,dumpPixmap      ,pIXMAP  )+                                 ,("icon_window"  ,dumpWindow      ,wINDOW  )+                                 ,("icon_x"       ,dump32          ,cARDINAL)+                                 ,("icon_y"       ,dump32          ,cARDINAL)+                                 ,("icon_mask"    ,dumpPixmap      ,pIXMAP  )+                                 ,("window_group" ,dumpWindow      ,wINDOW  )+                                 ]++dumpBits    :: [String] -> Decoder Bool+dumpBits bs =  guardType cARDINAL $ do+                 n <- getInt' 32+                 case n of+                   Nothing -> return False+                   Just n' -> dumpBits' bs 1 (fromIntegral n') ""++dumpBits' :: [String] -> Int -> Int -> String -> Decoder Bool+dumpBits' []     _ n p = if n == 0 then return True else append (p ++ show n)+dumpBits' (s:ss) b n p = do+  p' <- if n .&. b /= 0+        then append (p ++ s) >> return "|"+        else return p+  dumpBits' ss (b `shiftL` 1) (n .&. complement b) p'++-- enum definitions --++mwmFuncs :: [String]+mwmFuncs =  ["all except"+            ,"resize"+            ,"move"+            ,"minimize"+            ,"maximize"+            ,"close"+            ]++mwmDecos :: [String]+mwmDecos =  ["all except"+            ,"border"+            ,"resize handle"+            ,"title"+            ,"menu button"+            ,"maximize button"+            ,"minimize button"+            ]++mwmInputMode :: [String]+mwmInputMode =  ["modeless"+                ,"application modal"+                ,"system model"+                ,"full application modal"+                ]++mwmState :: [String]+mwmState =  ["tearoff window"+            ]++mwmHints :: [String]+mwmHints =  ["standard startup"+            ,"custom startup"+            ]++awSource :: [String]+awSource =  ["unspecified"+            ,"application"+            ,"pager/task list"+            ]++{- eventually...+wmHintsFlags :: [String]+wmHintsFlags =  ["Input"+                ,"State"+                ,"IconPixmap"+                ,"IconWindow"+                ,"IconX"+                ,"IconY"+                ,"IconMask"+                ,"WindowGroup"+                ]++wmCRMask :: [String]+wmCRMask =  ["X"+            ,"Y"+            ,"Width"+            ,"Height"+            ,"BorderWidth"+            ,"Sibling"+            ,"StackMode"+            ]+-}++wmPlacement :: [String]+wmPlacement =  ["Above"+               ,"Below"+               ,"TopIf"+               ,"BottomIf"+               ,"Opposite"+               ]++bool :: [String]+bool =  ["False","True"]++nwmOrientation :: [String]+nwmOrientation =  nwmEnum (Just "ORIENTATION") ["HORZ","VERT"]++nwmOrigin :: [String]+nwmOrigin =  nwmEnum Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"]++wmState :: [String]+wmState =  ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"]++nwmEnum                  :: Maybe String+                         -> [String]+                         -> [String]+nwmEnum Nothing       vs =  map ( "_NET_WM_"                   ++) vs+nwmEnum (Just prefix) vs =  map (("_NET_WM_" ++ prefix ++ "_") ++) vs++-- and the lowest level coercions --++-- parse and return an integral value+getInt'    :: Int -> Decoder (Maybe Integer)+-- see XSync documentation for this insanity+getInt' 64 =  guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $+              guardSize' 8 (propShortErr >> return Nothing) $ do+                lo <- inhale 32+                hi <- inhale 32+                return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)+getInt' w  =  guardR width w  (\a e -> propSizeErr a e >> return Nothing) $+              guardSize' (bytes w) (propShortErr >> return Nothing)       $+              Just `fmap` inhale w++-- parse an integral value and feed it to a show-er of some kind+getInt     :: Int -> (Integer -> String) -> Decoder Bool+getInt w f =  getInt' w >>= maybe (return False) (append . f)++-- bottommost level:  parse an integral value out of the stream.+-- Not much in the way of error checking; it is assumed you used+-- the appropriate guards.+-- @@@@@@@@@ evil beyond evil.  there *has* to be a better way+inhale    :: Int -> Decoder Integer+inhale  8 =  do+               [b] <- eat 1+               return $ fromIntegral b+inhale 16 =  do+               [b0,b1] <- eat 2+               io $ allocaArray 2 $ \p -> do+                 pokeArray p [b0,b1]+                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)+                 return $ fromIntegral v+inhale 32 =  do+               [b0,b1,b2,b3] <- eat 4+               io $ allocaArray 4 $ \p -> do+                 pokeArray p [b0,b1,b2,b3]+                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)+                 return $ fromIntegral v+inhale  b =  error $ "inhale " ++ show b++eat   :: Int -> Decoder Raw+eat n =  do+  (bs,rest) <- splitAt n `fmap` gets value+  modify (\r -> r {value = rest})+  return bs++-- actually do formatting type stuffs+-- sorta stubbed for the moment+-- eventually we should do indentation foo here+append :: String -> Decoder Bool+append =  append' True++-- and the same but for errors+failure :: String -> Decoder Bool+failure =  append' False++-- common appender+append'     :: Bool -> String -> Decoder Bool+append' b s =  do+  j <- gets joint+  modify (\r -> r {accum = accum r ++ j ++ s})+  return b++-- consume all and output a constant string+propSimple   :: String -> Decoder Bool+propSimple s =  modify (\r -> r {value = []}) >> append s++-- report various errors+propShortErr :: Decoder Bool+propShortErr =  failure "(property ended prematurely)"++propSizeErr     :: Int -> Int -> Decoder Bool+propSizeErr e a =  failure $ "(bad bit width " +++                             show a            +++                             "; expected "     +++                             show e            +++                             ")"++propTypeErr     :: Atom -> Atom -> Decoder Bool+propTypeErr a e =  do+  e' <- inX $ atomName e+  a' <- inX $ atomName a+  failure $ "(bad type " ++ a' ++"; expected " ++ e' ++ ")"++-- for stubs+(...) :: Decoder Bool+(...) =  do+  fmt <- asks pType >>= inX . atomName+  propSimple $ "(unimplemented type " ++ fmt ++ ")"++-- you like fi, I like this+twiddle :: (Enum a, Enum b) => a -> b+twiddle =  toEnum . fromEnum

@@ -45,7 +45,7 @@ -- Logged key events look like: -- -- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@--- +-- -- The @mask@ and @clean@ indicate the modifiers pressed along with -- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after -- sanitizing it (removing @numberLockMask@, etc.)

@@ -0,0 +1,93 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DebugStack+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  allbery.b@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- Dump the state of the 'StackSet'.  A @logHook@ and @handleEventHook@ are+-- also provided.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DebugStack (debugStack+                               ,debugStackString+                               ,debugStackLogHook+                               ,debugStackEventHook+                               ) where++import           XMonad.Core+import qualified XMonad.StackSet         as W++import           XMonad.Util.DebugWindow++import           Graphics.X11.Types                  (Window)+import           Graphics.X11.Xlib.Extras            (Event)++import           Control.Monad                       (foldM)+import           Data.Map                            (toList)+import           Data.Monoid                         (All(..))++-- | Print the state of the current window stack to @stderr@, which for most+--   installations goes to @~/.xsession-errors@.  "XMonad.Util.DebugWindow"+--   is used to display the individual windows.+debugStack :: X ()+debugStack =  debugStackString >>= trace++-- | The above packaged as a 'logHook'.  (Currently this is identical.)+debugStackLogHook :: X ()+debugStackLogHook =  debugStack++-- | The above packaged as a 'handleEventHook'.  You almost certainly do not+--   want to use this unconditionally, as it will cause massive amounts of+--   output and possibly slow @xmonad@ down severely.++debugStackEventHook   :: Event -> X All+debugStackEventHook _ =  debugStack >> return (All True)++-- | Dump the state of the current 'StackSet' as a multiline 'String'.+--   @+--   stack [    mm+--         ,(*) ww+--         ,    ww+--         ]+--   float {    ww+--         ,    ww+--         }+--   @+--+-- One thing I'm not sure of is where the zipper is when focus is on a+-- floating window.+debugStackString :: X String+debugStackString =  withWindowSet $ \ws -> do+                      s <- emit "stack" ("[","]") (W.peek ws)                    $ W.index    ws+                      f <- emit "float" ("{","}") (W.peek ws) $ map fst $ toList $ W.floating ws+                      return $ s ++ f+  where+    emit :: String -> (String,String) -> Maybe Window -> [Window] -> X String+    emit title (lb,rb) _       [] = return $ title ++ " " ++ lb ++ rb ++ "]\n"+    emit title (lb,rb) focused ws = do+      (_,_,_,_,ss) <- foldM emit' (title,lb,rb,focused,"") ws+      return $ ss                               +++               replicate (length title + 1) ' ' +++               rb                               +++               "\n"++    emit' :: (String,String,String,Maybe Window,String)+          -> Window+          -> X (String,String,String,Maybe Window,String)+    emit' (t,l,r,f,a) w = do+      w' <- emit'' f w+      return (replicate (length t) ' '+             ,',' : replicate (length l - 1) ' '+             ,r+             ,f+             ,a ++ t ++ " " ++ l ++ w' ++ "\n"+             )+    emit'' :: Maybe Window -> Window -> X String+    emit'' focus win =+      let fi f = if win == f then "(*) " else "    "+       in (maybe "    " fi focus ++) `fmap` debugWindow win

@@ -0,0 +1,136 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Hooks.DynamicBars+-- Copyright   :  (c) Ben Boeckel 2012+-- License     :  BSD-style (as xmonad)+--+-- Maintainer  :  mathstuf@gmail.com+-- Stability   :  unstable+-- Portability :  unportable+--+-- Manage per-screen status bars.+--+-----------------------------------------------------------------------------++module XMonad.Hooks.DynamicBars (+  -- * Usage+  -- $usage+    DynamicStatusBar+  , DynamicStatusBarCleanup+  , dynStatusBarStartup+  , dynStatusBarEventHook+  , multiPP+  ) where++import Prelude++import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans (lift)+import Control.Monad.Writer (WriterT, execWriterT, tell)++import Data.Maybe+import Data.Monoid+import Data.Traversable (traverse)++import Graphics.X11.Xinerama+import Graphics.X11.Xlib+import Graphics.X11.Xlib.Extras+import Graphics.X11.Xrandr++import System.IO+import System.IO.Unsafe++import XMonad+import qualified XMonad.StackSet as W+import XMonad.Hooks.DynamicLog++-- $usage+-- Provides a few helper functions to manage per-screen status bars while+-- dynamically responding to screen changes. A startup action, event hook, and+-- a way to separate PP styles based on the screen's focus are provided:+--+-- * The 'dynStatusBarStartup' hook which initializes the status bars.+--+-- * The 'dynStatusBarEventHook' hook which respawns status bars when the+-- number of screens changes.+--+-- * The 'multiPP' function which allows for different output based on whether+-- the screen for the status bar has focus.+--+-- The hooks take a 'DynamicStatusBar' function which is given the id of the+-- screen to start up and returns the 'Handle' to the pipe to write to. The+-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It+-- is called when the number of screens changes and on startup.+--++data DynStatusBarInfo = DynStatusBarInfo+  { dsbInfoScreens :: [ScreenId]+  , dsbInfoHandles :: [Handle]+  }++type DynamicStatusBar = ScreenId -> IO Handle+type DynamicStatusBarCleanup = IO ()++-- Global state+statusBarInfo :: MVar DynStatusBarInfo+statusBarInfo = unsafePerformIO $ newMVar (DynStatusBarInfo [] [])++dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()+dynStatusBarStartup sb cleanup = liftIO $ do+  dpy <- openDisplay ""+  xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask+  closeDisplay dpy+  updateStatusBars sb cleanup++dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All+dynStatusBarEventHook sb cleanup (RRScreenChangeNotifyEvent {}) = liftIO (updateStatusBars sb cleanup) >> return (All True)+dynStatusBarEventHook _  _       _                              = return (All True)++updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> IO ()+updateStatusBars sb cleanup = liftIO $ do+  dsbInfo <- takeMVar statusBarInfo+  screens <- getScreens+  if (screens /= (dsbInfoScreens dsbInfo))+    then do+      mapM hClose (dsbInfoHandles dsbInfo)+      cleanup+      newHandles <- mapM sb screens+      putMVar statusBarInfo (DynStatusBarInfo screens newHandles)+    else putMVar statusBarInfo dsbInfo++-----------------------------------------------------------------------------+-- The following code is from adamvo's xmonad.hs file.+-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs++multiPP :: PP -- ^ The PP to use if the screen is focused+        -> PP -- ^ The PP to use otherwise+        -> X ()+multiPP focusPP unfocusPP = do+  dsbInfo <- liftIO $ readMVar statusBarInfo+  multiPP' dynamicLogString focusPP unfocusPP (dsbInfoHandles dsbInfo)++multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()+multiPP' dynlStr focusPP unfocusPP handles = do+  st <- get+  let pickPP :: WorkspaceId -> WriterT (Last XState) X String+      pickPP ws = do+        let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st+        put st{ windowset = W.view ws $ windowset st }+        out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP+        when isFoc $ get >>= tell . Last . Just+        return out+  traverse put . getLast+    =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes+    =<< mapM screenWorkspace (zipWith const [0 .. ] handles)+  return ()++getScreens :: IO [ScreenId]+getScreens = do+  screens <- do+    dpy <- openDisplay ""+    rects <- getScreenInfo dpy+    closeDisplay dpy+    return rects+  let ids = zip [0 .. ] screens+  return $ map fst ids

@@ -20,6 +20,7 @@     ewmhDesktopsLogHook,     ewmhDesktopsLogHookCustom,     ewmhDesktopsEventHook,+    ewmhDesktopsEventHookCustom,     fullscreenEventHook     ) where @@ -43,9 +44,10 @@ -- > import XMonad -- > import XMonad.Hooks.EwmhDesktops -- >--- > main = xmonad $ ewmh defaultConfig+-- > main = xmonad $ ewmh defaultConfig{ handleEventHook =+-- >            handleEventHook defaultConfig <+> fullscreenEventHook } ----- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks.+-- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks".   -- | Add EWMH functionality to the given config.  See above for an example.@@ -116,18 +118,23 @@ --  * _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)+ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id -handle :: Event -> X ()-handle ClientMessageEvent {+-- |+-- Generalized version of ewmhDesktopsEventHook that allows an arbitrary+-- user-specified function to transform the workspace list (post-sorting)+ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All+ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)++handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()+handle f (ClientMessageEvent {                ev_window = w,                ev_message_type = mt,                ev_data = d-       } = withWindowSet $ \s -> do+       }) = withWindowSet $ \s -> do        sort' <- getSortByIndex-       let ws = sort' $ W.workspaces s+       let ws = f $ sort' $ W.workspaces s         a_cd <- getAtom "_NET_CURRENT_DESKTOP"        a_d <- getAtom "_NET_WM_DESKTOP"@@ -154,17 +161,19 @@           -- The Message is unknown to us, but that is ok, not all are meant           -- to be handled by the window manager           return ()-handle _ = return ()+handle _ _ = return ()  -- | -- An event hook to handle applications that wish to fullscreen using the -- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen() -- function, such as Totem, Evince and OpenOffice.org.+--+-- Note this is not included in 'ewmh'. fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do-  state <- getAtom "_NET_WM_STATE"+  wmstate <- getAtom "_NET_WM_STATE"   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"-  wstate <- fromMaybe [] `fmap` getProp32 state win+  wstate <- fromMaybe [] `fmap` getProp32 wmstate win    let isFull = fromIntegral fullsc `elem` wstate @@ -173,9 +182,9 @@       add = 1       toggle = 2       ptype = 4 -- The atom property type for changeProperty-      chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)+      chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate) -  when (typ == state && fi fullsc `elem` dats) $ do+  when (typ == wmstate && fi fullsc `elem` dats) $ do     when (action == add || (action == toggle && not isFull)) $ do       chWstate (fi fullsc:)       windows $ W.float win $ W.RationalRect 0 0 1 1

@@ -17,10 +17,12 @@     -- $usage     setOpacity,     isUnfocused,+    isUnfocusedOnCurrentWS,     fadeIn,     fadeOut,     fadeIf,     fadeInactiveLogHook,+    fadeInactiveCurrentWSLogHook,     fadeOutLogHook     ) where @@ -58,18 +60,18 @@     | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability     | otherwise = round $ perc * 0xffffffff --- | sets the opacity of a window+-- | Sets the opacity of a window setOpacity :: Window -> Rational -> X () setOpacity w t = withDisplay $ \dpy -> do     a <- getAtom "_NET_WM_WINDOW_OPACITY"     c <- getAtom "CARDINAL"     io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t] --- | fades a window out by setting the opacity+-- | Fades a window out by setting the opacity fadeOut :: Rational -> Window -> X () fadeOut = flip setOpacity --- | makes a window completely opaque+-- | Makes a window completely opaque fadeIn :: Window -> X () fadeIn = fadeOut 1 @@ -78,15 +80,34 @@ fadeIf :: Query Bool -> Rational -> Query Rational fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1 --- | sets the opacity of inactive windows to the specified amount+-- | Sets the opacity of inactive windows to the specified amount fadeInactiveLogHook :: Rational -> X () fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused --- | returns True if the window doesn't have the focus.+-- | Set the opacity of inactive windows, on the current workspace, to the+-- specified amount. This is specifically usefull in a multi monitor setup. See+-- 'isUnfocusedOnCurrentWS'.+fadeInactiveCurrentWSLogHook :: Rational -> X ()+fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS++-- | Returns True if the window doesn't have the focus. isUnfocused :: Query Bool isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset --- | fades out every window by the amount returned by the query.+-- | Returns True if the window doesn't have the focus, and the window is on the+-- current workspace. This is specifically handy in a multi monitor setup+-- (xinerama) where multiple workspaces are visible. Using this, non-focused+-- workspaces are are not faded out making it easier to look and read the+-- content on them.+isUnfocusedOnCurrentWS :: Query Bool+isUnfocusedOnCurrentWS = do+  w <- ask+  ws <- liftX $ gets windowset+  let thisWS = w `elem` W.index ws+      unfocused = maybe True (w /=) $ W.peek ws+  return $ thisWS && unfocused++-- | Fades out every window by the amount returned by the query. fadeOutLogHook :: Query Rational -> X () fadeOutLogHook qry = withWindowSet $ \s -> do     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++

@@ -105,7 +105,7 @@ -- -- "XMonad.Doc.Extending#Editing_the_event_hook" -- (which sadly doesnt exist at the time of writing...)--- +-- -- /WARNING:/  This module is very good at triggering bugs in -- compositing managers.  Symptoms range from windows not being -- repainted until the compositing manager is restarted or the

@@ -18,8 +18,9 @@ -- @ ----------------------------------------------------------------------------- module XMonad.Hooks.ICCCMFocus+{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-} (-  atom_WM_TAKE_FOCUS  +  atom_WM_TAKE_FOCUS , takeFocusX , takeTopFocus ) where@@ -27,31 +28,15 @@ import XMonad import XMonad.Hooks.SetWMName import qualified XMonad.StackSet as W-import Control.Monad -atom_WM_TAKE_FOCUS ::-  X Atom-atom_WM_TAKE_FOCUS =-  getAtom "WM_TAKE_FOCUS"- takeFocusX ::   Window   -> X ()-takeFocusX w =-  withWindowSet . const $ do-    dpy       <- asks display-    wmtakef   <- atom_WM_TAKE_FOCUS-    wmprot    <- atom_WM_PROTOCOLS-    protocols <- io $ getWMProtocols dpy w-    when (wmtakef `elem` protocols) $-      io . allocaXEvent $ \ev -> do-          setEventType ev clientMessage-          setClientMessageEvent ev w wmprot 32 wmtakef currentTime-          sendEvent dpy w False noEventMask ev+takeFocusX _w = return ()  -- | The value to add to your log hook configuration. takeTopFocus ::   X () takeTopFocus =-  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"  +  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D" 

@@ -111,8 +111,8 @@     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+        Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)+        _       -> return False  -- | Whenever a new dock appears, refresh the layout immediately to avoid the -- new dock.

@@ -26,8 +26,6 @@ -- import XMonad -import System.Directory- -- $usage -- -- This module allows you to run a centrally located script with the text@@ -47,7 +45,7 @@  -- | Execute a named script hook execScriptHook :: MonadIO m => String -> m ()-execScriptHook hook = io $ do-  home <- getHomeDirectory-  let script = home ++ "/.xmonad/hooks "+execScriptHook hook = do+  xmonadDir <- getXMonadDir+  let script = xmonadDir ++ "/hooks "   spawn (script ++ hook)

@@ -63,10 +63,11 @@  {- The current state is kept here -} -data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable)+data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)  instance ExtensionClass HookState where     initialValue = HookState empty+    extensionType = PersistentExtension  modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X () modify' n f = XS.modify (HookState . setter . hooks)

@@ -59,6 +59,7 @@                                  dzenUrgencyHook,                                  DzenUrgencyHook(..),                                  NoUrgencyHook(..),+                                 BorderUrgencyHook(..),                                  FocusHook(..),                                  minutes, seconds,                                  -- * Stuff for developers:@@ -67,6 +68,7 @@                                  SpawnUrgencyHook(..),                                  UrgencyHook(urgencyHook),                                  Interval,+                                 borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook                                  ) where  import XMonad@@ -83,6 +85,7 @@ import Data.List (delete, (\\)) import Data.Maybe (listToMaybe, maybeToList) import qualified Data.Set as S+import System.IO (hPutStrLn, stderr)  -- $usage --@@ -388,9 +391,12 @@  -- | The class definition, and some pre-defined instances. -class (Read h, Show h) => UrgencyHook h where+class UrgencyHook h where     urgencyHook :: h -> Window -> X () +instance UrgencyHook (Window -> X ()) where+    urgencyHook = id+ data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)  instance UrgencyHook NoUrgencyHook where@@ -418,11 +424,40 @@    > withUrgencyHook FocusHook $ myconfig { ... -}+focusHook :: Window -> X ()+focusHook = urgencyHook FocusHook data FocusHook = FocusHook deriving (Read, Show)  instance UrgencyHook FocusHook where     urgencyHook _ _ = focusUrgent +-- | A hook that sets the border color of an urgent window.  The color+--   will remain until the next time the window gains or loses focus, at+--   which point the standard border color from the XConfig will be applied.+--   You may want to use suppressWhen = Never with this:+--+--   > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ...+--+--   (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration".+--   @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt".  We need to+--   think a bit more about namespacing issues, maybe.)++borderUrgencyHook :: String -> Window -> X ()+borderUrgencyHook = urgencyHook . BorderUrgencyHook+data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }+                       deriving (Read, Show)++instance UrgencyHook BorderUrgencyHook where+  urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =+    withDisplay $ \dpy -> io $ do+      c' <- initColor dpy cs+      case c' of+        Just c -> setWindowBorder dpy w c+        _      -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "+                                            ,show cs+                                            ," in BorderUrgencyHook"+                                            ]+ -- | 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'.@@ -432,12 +467,16 @@ -- | 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.+spawnUrgencyHook :: String -> Window -> X ()+spawnUrgencyHook = urgencyHook . SpawnUrgencyHook newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)  instance UrgencyHook SpawnUrgencyHook where     urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w  -- | For debugging purposes, really.+stdoutUrgencyHook :: Window -> X ()+stdoutUrgencyHook = urgencyHook StdoutUrgencyHook data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)  instance UrgencyHook StdoutUrgencyHook where

@@ -18,8 +18,7 @@                  xPropManageHook, XPropMatch, pmX, pmP                  ) where -import Prelude hiding (catch)-import Control.Exception+import Control.Exception as E import Data.Char (chr) import Data.Monoid (mconcat, Endo(..)) @@ -76,7 +75,7 @@  getProp :: Display -> Window -> Atom -> X ([String]) getProp d w p = do-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])+    prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])     let filt q | q == wM_COMMAND = concat . map splitAtNull                | otherwise       = id     return (filt p prop)

@@ -59,10 +59,8 @@  data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) -brBorderOffset :: Position-brBorderOffset = 5 brBorderSize :: Dimension-brBorderSize = 10+brBorderSize = 2  borderResize :: l a -> ModifiedLayout BorderResize l a borderResize = ModifiedLayout (BR M.empty)@@ -147,10 +145,10 @@  prepareBorders :: Rectangle -> [BorderBlueprint] prepareBorders (Rectangle x y wh ht) =-    [((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder),-     ((Rectangle (x - brBorderOffset) y brBorderSize ht)        , xC_left_side  , LeftSideBorder),-     ((Rectangle x (y - brBorderOffset) wh brBorderSize)        , xC_top_side   , TopSideBorder),-     ((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder)+    [((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder),+     ((Rectangle x y brBorderSize ht)                            , xC_left_side  , LeftSideBorder),+     ((Rectangle x y wh brBorderSize)                            , xC_top_side   , TopSideBorder),+     ((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder)     ]  handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()

@@ -53,7 +53,7 @@ -- To use this module, add 'fullscreenEventHook' and 'fullscreenManageHook' -- to your config, i.e. ----- > xmonad defaultconfig { eventHook = fullscreenEventHook,+-- > xmonad defaultconfig { handleEventHook = fullscreenEventHook, -- >                        manageHook = fullscreenManageHook, -- >                        layoutHook = myLayouts } --@@ -124,11 +124,11 @@      -- Modify the floating member of the stack set directly; this is the hackish part.     Just FullscreenChanged -> do-      state <- get-      let ws = windowset state+      st <- get+      let ws = windowset st           flt = W.floating ws           flt' = M.intersectionWith doFull fulls flt-      put state {windowset = ws {W.floating = M.union flt' flt}}+      put st {windowset = ws {W.floating = M.union flt' flt}}       return $ Just $ FullscreenFloat frect $ M.filter snd fulls       where doFull (_, True) _ = frect             doFull (rect, False) _ = rect@@ -174,9 +174,9 @@ -- | The event hook required for the layout modifiers to work fullscreenEventHook :: Event -> X All fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do-  state <- getAtom "_NET_WM_STATE"+  wmstate <- getAtom "_NET_WM_STATE"   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"-  wstate <- fromMaybe [] `fmap` getProp32 state win+  wstate <- fromMaybe [] `fmap` getProp32 wmstate win   let fi :: (Integral i, Num n) => i -> n       fi = fromIntegral       isFull = fi fullsc `elem` wstate@@ -184,8 +184,8 @@       add = 1       toggle = 2       ptype = 4-      chWState f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)-  when (typ == state && fi fullsc `elem` dats) $ do+      chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)+  when (typ == wmstate && fi fullsc `elem` dats) $ do     when (action == add || (action == toggle && not isFull)) $ do       chWState (fi fullsc:)       broadcastMessage $ AddFullscreen win

@@ -70,9 +70,9 @@ -- group, and the layout with which the groups themselves will -- be arranged on the screen. ----- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii" --- modules contain examples of layouts that can be defined with this --- combinator. They're also the recommended starting point +-- The "XMonad.Layout.Groups.Examples" and "XMonad.Layout.Groups.Wmii"+-- modules contain examples of layouts that can be defined with this+-- combinator. They're also the recommended starting point -- if you are a beginner and looking for something you can use easily. -- -- One thing to note is that 'Groups'-based layout have their own@@ -81,7 +81,7 @@ -- will have no visible effect, and those like 'XMonad.StackSet.focusUp' -- will focus the windows in an unpredictable order. For a better way of -- rearranging windows and moving focus in such a layout, see the--- example 'ModifySpec's (to be passed to the 'Modify' message) provided +-- example 'ModifySpec's (to be passed to the 'Modify' message) provided -- by this module. -- -- If you use both 'Groups'-based and other layouts, The "XMonad.Layout.Groups.Helpers"@@ -105,7 +105,7 @@ data Uniq = U Integer Integer   deriving (Eq, Show, Read) --- | From a seed, generate an infinite list of keys and a new +-- | From a seed, generate an infinite list of keys and a new -- seed. All keys generated with this method will be different -- provided you don't use 'gen' again with a key from the list. -- (if you need to do that, see 'split' instead)@@ -121,7 +121,7 @@  -- | Add a unique identity to a layout so we can -- follow it around.-data WithID l a = ID { getID :: Uniq +data WithID l a = ID { getID :: Uniq                      , unID :: (l a)}   deriving (Show, Read) @@ -133,16 +133,16 @@     ID id1 _ == ID id2 _ = id1 == id2  instance LayoutClass l a => LayoutClass (WithID l) a where-    runLayout ws@W.Workspace { W.layout = ID id l } r -        = do (placements, ml') <- flip runLayout r +    runLayout ws@W.Workspace { W.layout = ID id l } r+        = do (placements, ml') <- flip runLayout r                                      ws { W.layout = l}              return (placements, ID id <$> ml')     handleMessage (ID id l) sm = do ml' <- handleMessage l sm                                     return $ ID id <$> ml'     description (ID _ l) = description l -           + -- * The 'Groups' layout  @@ -211,7 +211,7 @@  -- | Adapt our groups to a new stack. -- This algorithm handles window additions and deletions correctly,--- ignores changes in window ordering, and tries to react to any +-- ignores changes in window ordering, and tries to react to any -- other stack changes as gracefully as possible. readapt :: Eq a => Zipper a -> Groups l l2 a -> Groups l l2 a readapt z g = let mf = getFocusZ z@@ -233,7 +233,7 @@ removeDeleted z = filterZ_ (flip elemZ z)  -- | Identify the windows not already in a group.-findNewWindows :: Eq a => [a] -> Zipper (Group l a) +findNewWindows :: Eq a => [a] -> Zipper (Group l a)                -> (Zipper (Group l a), [a]) findNewWindows as gs = (gs, foldrZ_ removePresent as gs)     where removePresent g as' = filter (not . flip elemZ (gZipper g)) as'@@ -279,10 +279,10 @@                 let placements = concatMap fst results                    newL = justMakeNew l mpart' (map snd results ++ hidden')-                                        +                return $ (placements, newL) -        handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm +        handleMessage l@(Groups _ p _ _) sm | Just (ToEnclosing sm') <- fromMessage sm             = do mp' <- handleMessage p sm'                  return $ maybeMakeNew l mp' [] @@ -316,7 +316,7 @@                             step _ = return Nothing  -justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)] +justMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]             -> Maybe (Groups l l2 a) justMakeNew g mpart' ml's = Just g { partitioner = fromMaybe (partitioner g) mpart'                                    , groups = combine (groups g) ml's }@@ -339,7 +339,7 @@  -- ** ModifySpec type --- | Type of functions describing modifications to a 'Groups' layout. They +-- | Type of functions describing modifications to a 'Groups' layout. They -- are transformations on 'Zipper's of groups. -- -- Things you shouldn't do:@@ -358,8 +358,8 @@ -- 'ModifySpec's as arguments, or returning them,  you'll need to write a type -- signature and add @{-# LANGUAGE Rank2Types #-}@ at the beginning type ModifySpec = forall l. WithID l Window-                -> Zipper (Group l Window)                  -> Zipper (Group l Window)+                -> Zipper (Group l Window)  -- | Apply a ModifySpec. applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)@@ -367,7 +367,7 @@                     g' = flip modifyGroups g $ f (ID id $ baseLayout g)                                                >>> toTags                                                >>> foldr reID ((ids, []), [])-                                               >>> snd +                                               >>> snd                                                >>> fromTags                 in case groups g == groups g' of                      True -> Nothing@@ -448,7 +448,7 @@  -- helper _moveToNewGroup :: WithID l Window -> W.Stack (Group l Window)-                -> (Group l Window -> Zipper (Group l Window) +                -> (Group l Window -> Zipper (Group l Window)                                    -> Zipper (Group l Window))                 -> Zipper (Group l Window) _moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s@@ -456,7 +456,7 @@           s' = s { W.focus = G l f' }       in insertX (G l0 $ singletonZ w) $ Just s' _moveToNewGroup _ s _ = Just s- + -- | Move the focused window to a new group before the current one. moveToNewGroupUp :: ModifySpec moveToNewGroupUp _ Nothing = Nothing

@@ -67,12 +67,12 @@   -- $usage--- This module contains example 'G.Groups'-based layouts. +-- This module contains example 'G.Groups'-based layouts. -- You can either import this module directly, or look at its source -- for ideas of how "XMonad.Layout.Groups" may be used. -- -- You can use the contents of this module by adding--- +-- -- > import XMonad.Layout.Groups.Examples -- -- to the top of your @.\/.xmonad\/xmonad.hs@.@@ -80,10 +80,10 @@ -- For more information on using any of the layouts, jump directly --   to its \"Example\" section. ----- Whichever layout you choose to use, you will probably want to be +-- Whichever layout you choose to use, you will probably want to be --   able to move focus and windows between groups in a consistent --   manner. For this, you should take a look at the functions from---   the "XMonad.Layout.Groups.Helpers" module, which are all +--   the "XMonad.Layout.Groups.Helpers" module, which are all --   re-exported by this module. -- -- For more information on how to extend your layour hook and key bindings, see@@ -99,7 +99,7 @@ instance Eq a => EQF GroupEQ (G.Group l a) where     eq _ (G.G l1 _) (G.G l2 _) = G.sameID l1 l2 -zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a)) +zoomRowG :: (Eq a, Show a, Read a, Show (l a), Read (l a))             => ZoomRow GroupEQ (G.Group l a) zoomRowG = zoomRowWith GroupEQ @@ -171,10 +171,10 @@  -- $example2 -- A layout which arranges windows into tabbed groups, and the groups--- themselves according to XMonad's default algorithm +-- themselves according to XMonad's default algorithm -- (@'Tall' ||| 'Mirror' 'Tall' ||| 'Full'@). As their names--- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts --- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any +-- indicate, 'tallTabs' starts as 'Tall', 'mirrorTallTabs' starts+-- as 'Mirror' 'Tall' and 'fullTabs' starts as 'Full', but in any -- case you can freely switch between the three afterwards. -- -- You can use any of these three layouts by including it in your layout hook.@@ -204,7 +204,7 @@ defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker defaultTiledTabsConfig = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText defaultTheme -fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c +fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c  tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full 

@@ -69,7 +69,7 @@ -- This module provides actions that try to send 'G.GroupsMessage's, and -- fall back to the classic way if the current layout doesn't hande them. -- They are in the section called \"Layout-generic actions\".--- +-- -- The sections \"Groups-specific actions\" contains actions that don't make -- sense for non-'G.Groups'-based layouts. These are simply wrappers around -- the equivalent 'G.GroupsMessage's, but are included so you don't have to@@ -139,7 +139,7 @@  focusNonFloat :: X () focusNonFloat = alt2 G.Refocus helper-    where helper = withFocused $ \w -> do +    where helper = withFocused $ \w -> do                      ws <- getWindows                      floats <- getFloats                      let (before,  after) = span (/=w) ws@@ -170,7 +170,7 @@  focusFloatUp :: X () focusFloatUp = focusHelper id reverse-                 + focusFloatDown :: X () focusFloatDown = focusHelper id id 

@@ -17,7 +17,7 @@  module XMonad.Layout.Groups.Wmii ( -- * Usage                                    -- $usage-                                   +                                    wmii                                  , zoomGroupIn                                  , zoomGroupOut@@ -48,9 +48,9 @@   -- $usage--- This module provides a layout inspired by the one used by the wmii +-- This module provides a layout inspired by the one used by the wmii -- (<http://wmii.suckless.org>) window manager.--- Windows are arranged into groups in a horizontal row, and each group can lay out +-- Windows are arranged into groups in a horizontal row, and each group can lay out -- its windows -- --   * by maximizing the focused one@@ -59,16 +59,16 @@ -- --   * by arranging them in a column. ----- As the groups are arranged in a 'ZoomRow', the relative width of each group can be --- increased or decreased at will. Groups can also be set to use the whole screen +-- As the groups are arranged in a 'ZoomRow', the relative width of each group can be+-- increased or decreased at will. Groups can also be set to use the whole screen -- whenever they have focus. -- -- You can use the contents of this module by adding--- +-- -- > import XMonad.Layout.Groups.Wmii ----- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii' --- (with a 'Shrinker' and decoration 'Theme' as +-- to the top of your @.\/.xmonad\/xmonad.hs@, and adding 'wmii'+-- (with a 'Shrinker' and decoration 'Theme' as -- parameters) to your layout hook, for example: -- -- > myLayout = wmii shrinkText defaultTheme@@ -92,10 +92,10 @@ wmii s t = G.group innerLayout zoomRowG     where column = named "Column" $ Tall 0 (3/100) (1/2)           tabs = named "Tabs" $ Simplest-          innerLayout = renamed [CutWordsLeft 3] +          innerLayout = renamed [CutWordsLeft 3]                         $ addTabs s t-                        $ ignore NextLayout -                        $ ignore (JumpToLayout "") $ unEscape +                        $ ignore NextLayout+                        $ ignore (JumpToLayout "") $ unEscape                            $ column ||| tabs ||| Full  -- | Increase the width of the focused group

@@ -140,7 +140,7 @@   closeButton :: [[Bool]]-closeButton = convertToBool closeButton'    +closeButton = convertToBool closeButton'  -- | A function intended to be plugged into the 'decorationCatchClicksHook' of a decoration. -- It will intercept clicks on the buttons of the decoration and invoke the associated action.

@@ -40,7 +40,7 @@ -- -- compare "XMonad.Util.Invisible" --- | Type class for predicates. This enables us to manage not only Windows, +-- | Type class for predicates. This enables us to manage not only Windows, -- but any objects, for which instance Predicate is defined. -- -- Another instance exists in XMonad.Util.WindowPropertiesRE in xmonad-extras

@@ -84,12 +84,12 @@ setMinimizedState win st f = do     setWMState win st     withDisplay $ \dpy -> do-        state <- getAtom "_NET_WM_STATE"+        wm_state <- getAtom "_NET_WM_STATE"         mini <- getAtom "_NET_WM_STATE_HIDDEN"-        wstate <- fromMaybe [] `fmap` getProp32 state win+        wstate <- fromMaybe [] `fmap` getProp32 wm_state win         let ptype = 4 -- The atom property type for changeProperty             fi_mini = fromIntegral mini-        io $ changeProperty32 dpy win state ptype propModeReplace (f fi_mini wstate)+        io $ changeProperty32 dpy win wm_state ptype propModeReplace (f fi_mini wstate)  setMinimized :: Window -> X () setMinimized win = setMinimizedState win iconicState (:)

@@ -136,55 +136,55 @@ mouseResizableTileMirrored = mouseResizableTile { isMirrored = True }  instance LayoutClass MouseResizableTile Window where-    doLayout state sr (W.Stack w l r) = do-        drg <- draggerGeometry $ draggerType state+    doLayout st sr (W.Stack w l r) = do+        drg <- draggerGeometry $ draggerType st         let wins = reverse l ++ w : r             num = length wins             sr' = mirrorAdjust sr (mirrorRect sr)-            (rects, preparedDraggers) = tile (nmaster state) (masterFrac state)-                                            (leftFracs state ++ repeat (slaveFrac state))-                                            (rightFracs state ++ repeat (slaveFrac state)) sr' num drg+            (rects, preparedDraggers) = tile (nmaster st) (masterFrac st)+                                            (leftFracs st ++ repeat (slaveFrac st))+                                            (rightFracs st ++ repeat (slaveFrac st)) sr' num drg             rects' = map (mirrorAdjust id mirrorRect . sanitizeRectangle sr') rects-        mapM_ deleteDragger $ draggers state+        mapM_ deleteDragger $ draggers st         (draggerWrs, newDraggers) <- unzip <$> mapM-                                        (createDragger sr . adjustForMirror (isMirrored state))+                                        (createDragger sr . adjustForMirror (isMirrored st))                                         preparedDraggers-        return (draggerWrs ++ zip wins rects', Just $ state { draggers = newDraggers,+        return (draggerWrs ++ zip wins rects', Just $ st { draggers = newDraggers,                                                               focusPos = length l,                                                               numWindows = length wins })         where-            mirrorAdjust a b = if (isMirrored state)+            mirrorAdjust a b = if (isMirrored st)                                 then b                                 else a -    handleMessage state m+    handleMessage st m         | Just (IncMasterN d) <- fromMessage m =-            return $ Just $ state { nmaster = max 0 (nmaster state + d) }+            return $ Just $ st { nmaster = max 0 (nmaster st + d) }         | Just Shrink <- fromMessage m =-            return $ Just $ state { masterFrac = max 0 (masterFrac state - fracIncrement state) }+            return $ Just $ st { masterFrac = max 0 (masterFrac st - fracIncrement st) }         | Just Expand <- fromMessage m =-            return $ Just $ state { masterFrac = min 1 (masterFrac state + fracIncrement state) }+            return $ Just $ st { masterFrac = min 1 (masterFrac st + fracIncrement st) }         | Just ShrinkSlave <- fromMessage m =-            return $ Just $ modifySlave state (- fracIncrement state)+            return $ Just $ modifySlave st (- fracIncrement st)         | Just ExpandSlave <- fromMessage m =-            return $ Just $ modifySlave state (fracIncrement state)+            return $ Just $ modifySlave st (fracIncrement st)         | Just (SetMasterFraction f) <- fromMessage m =-            return $ Just $ state { masterFrac = max 0 (min 1 f) }+            return $ Just $ st { masterFrac = max 0 (min 1 f) }         | Just (SetLeftSlaveFraction pos f) <- fromMessage m =-            return $ Just $ state { leftFracs = replaceAtPos (slaveFrac state)-                (leftFracs state) pos (max 0 (min 1 f)) }+            return $ Just $ st { leftFracs = replaceAtPos (slaveFrac st)+                (leftFracs st) pos (max 0 (min 1 f)) }         | Just (SetRightSlaveFraction pos f) <- fromMessage m =-            return $ Just $ state { rightFracs = replaceAtPos (slaveFrac state)-                (rightFracs state) pos (max 0 (min 1 f)) }+            return $ Just $ st { rightFracs = replaceAtPos (slaveFrac st)+                (rightFracs st) 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+        | Just e <- fromMessage m :: Maybe Event = handleResize (draggers st) (isMirrored st) e >> return Nothing+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] })+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ st { draggers = [] })+        where releaseResources = mapM_ deleteDragger $ draggers st     handleMessage _ _ = return Nothing -    description state = mirror "MouseResizableTile"-        where mirror = if isMirrored state then ("Mirror " ++) else id+    description st = mirror "MouseResizableTile"+        where mirror = if isMirrored st then ("Mirror " ++) else id  draggerGeometry :: DraggerType -> X DraggerGeometry draggerGeometry (FixedDragger g d) =@@ -203,28 +203,28 @@                             else xC_sb_h_double_arrow  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-        slFrac = slaveFrac state+modifySlave st delta =+    let pos = focusPos st+        num = numWindows st+        nmaster' = nmaster st+        leftFracs' = leftFracs st+        rightFracs' = rightFracs st+        slFrac = slaveFrac st         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 slFrac) !! draggerPos-                     in state { leftFracs = replaceAtPos slFrac leftFracs' draggerPos+                     in st { leftFracs = replaceAtPos slFrac leftFracs' draggerPos                                             (max 0 (min 1 (oldFraction + delta))) }-                else state+                else st         else if draggersRight > 0                 then let draggerPos = min (draggersRight - 1) (pos - nmaster')                          oldFraction = (rightFracs' ++ repeat slFrac) !! draggerPos-                     in state { rightFracs = replaceAtPos slFrac rightFracs' draggerPos+                     in st { rightFracs = replaceAtPos slFrac rightFracs' draggerPos                                             (max 0 (min 1 (oldFraction + delta))) }-                else state+                else st  replaceAtPos :: (Num t, Eq t) => Rational -> [Rational] -> t -> Rational -> [Rational] replaceAtPos _ [] 0 x' = [x']

@@ -0,0 +1,155 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Layout.OnHost+-- Copyright   :  (c) Brandon S Allbery, Brent Yorgey+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  <allbery.b@gmail.com>+-- Stability   :  unstable+-- Portability :  unportable+--+-- Configure layouts on a per-host basis: use layouts and apply+-- layout modifiers selectively, depending on the host.  Heavily based on+-- "XMonad.Layout.PerWorkspace" by Brent Yorgey.+-----------------------------------------------------------------------------++module XMonad.Layout.OnHost (-- * Usage+                             -- $usage+                             OnHost+                            ,onHost+                            ,onHosts+                            ,modHost+                            ,modHosts+                            ) where++import           XMonad+import qualified XMonad.StackSet              as W++import           XMonad.Layout.LayoutModifier++import           Data.Maybe                        (fromMaybe)+import           System.Posix.Env                  (getEnv)++-- $usage+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:+--+-- > import XMonad.Layout.OnHost+--+-- and modifying your 'layoutHook' as follows (for example):+--+-- > layoutHook = modHost "baz" m1 $            -- apply layout modifier m1 to all layouts on host "baz"+-- >              onHost "foo" l1 $             -- layout l1 will be used on host "foo".+-- >              onHosts ["bar","quux"] l2 $   -- layout l2 will be used on hosts "bar" and "quux".+-- >              l3                            -- layout l3 will be used on all other hosts.+--+-- 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 hosts, except that on host foo you want+-- layout D instead of C.  You could do that as follows:+--+-- > layoutHook = A ||| B ||| onHost "foo" D C+--+-- Note that we rely on '$HOST' being set in the environment, as is true on most+-- modern systems; if it's not, you may want to use a wrapper around xmonad or+-- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'.+-- This is to avoid dragging in the network package as an xmonad dependency.+-- If '$HOST' is not defined, it will behave as if the host name never matches.+--+-- Also note that '$HOST' is usually a fully qualified domain name, not a short name.+-- If you use a short name, this code will try to truncate $HOST to match; this may+-- prove too magical, though, and may change in the future.++-- | Specify one layout to use on a particular host, and another+--   to use on all others.  The second layout can be another call to+--   'onHost', and so on.+onHost :: (LayoutClass l1 a, LayoutClass l2 a)+       => String -- ^ the name of the host to match+       -> (l1 a) -- ^ layout to use on the matched host+       -> (l2 a) -- ^ layout to use everywhere else+       -> OnHost l1 l2 a+onHost host = onHosts [host]++-- | Specify one layout to use on a particular set of hosts, and+--   another to use on all other hosts.+onHosts :: (LayoutClass l1 a, LayoutClass l2 a)+        => [String] -- ^ names of hosts to match+        -> (l1 a)   -- ^ layout to use on matched hosts+        -> (l2 a)   -- ^ layout to use everywhere else+        -> OnHost l1 l2 a+onHosts hosts l1 l2 = OnHost hosts False l1 l2++-- | Specify a layout modifier to apply on a particular host; layouts+--   on all other hosts will remain unmodified.+modHost :: (LayoutClass l a)+        => String                          -- ^ name of the host to match+        -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching host+        -> l a                             -- ^ the base layout+        -> OnHost (ModifiedLayout lm l) l a+modHost host = modHosts [host]++-- | Specify a layout modifier to apply on a particular set of+--   hosts; layouts on all other hosts will remain+--   unmodified.+modHosts :: (LayoutClass l a)+         => [String]                        -- ^ names of the hosts to match+         -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching hosts+         -> l a                             -- ^ the base layout+         -> OnHost (ModifiedLayout lm l) l a+modHosts hosts f l = OnHost hosts False (f l) l++-- | Structure for representing a host-specific layout along with+--   a layout for all other hosts. We store the names of hosts+--   to be matched, and the two layouts. We save the layout choice in+--   the Bool, to be used to implement description.+data OnHost l1 l2 a = OnHost [String]+                             Bool+                             (l1 a)+                             (l2 a)+    deriving (Read, Show)++instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where+    runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do+      h <- io $ getEnv "HOST"+      if maybe False (`elemFQDN` hosts) h+        then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r+                return (wrs, Just $ mkNewOnHostT p mlt')+        else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r+                return (wrs, Just $ mkNewOnHostF p mlt')++    handleMessage (OnHost hosts bool lt lf) m+        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf)+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ OnHost hosts bool lt nf)++    description (OnHost _ True  l1 _) = description l1+    description (OnHost _ _     _ l2) = description l2++-- | Construct new OnHost values with possibly modified layouts.+mkNewOnHostT :: OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a+mkNewOnHostT (OnHost hosts _ lt lf) mlt' =+  (\lt' -> OnHost hosts True lt' lf) $ fromMaybe lt mlt'++mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a+mkNewOnHostF (OnHost hosts _ lt lf) mlf' =+  (\lf' -> OnHost hosts False lt lf') $ fromMaybe lf mlf'++-- | 'Data.List.elem' except that if one side has a dot and the other doesn't, we truncate+--   the one that does at the dot.+elemFQDN           :: String -> [String] -> Bool+elemFQDN _  []     =  False+elemFQDN h0 (h:hs)+  | h0 `eqFQDN` h  =  True+  | otherwise      =  elemFQDN h0 hs++-- | String equality, possibly truncating one side at a dot.+eqFQDN :: String -> String -> Bool+eqFQDN a b+  | '.' `elem` a && '.' `elem` b =                    a ==                    b+  | '.' `elem` a                 = takeWhile (/= '.') a ==                    b+  |                 '.' `elem` b =                    a == takeWhile (/= '.') b+  | otherwise                    =                    a ==                    b

@@ -24,7 +24,7 @@ import XMonad.Layout.LayoutModifier  -- $usage--- You can use this module by adding +-- You can use this module by adding -- -- > import XMonad.Layout.Renamed --

@@ -86,18 +86,18 @@ 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+flashName c (Rectangle sx sy wh ht) wrs = do   d <- asks display   n <- withWindowSet (return . S.currentTag)   f <- initXMF (swn_font c)-  width   <- textWidthXMF d f n+  width <- fmap (\w -> w + w `div` length n) $ 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+      y     = fi sy + (fi ht - hight + 2) `div` 2+      x     = fi sx + (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]+  paintAndWrite w f (fi width) (fi hight) 0 (swn_bgcolor c) "" (swn_color c) (swn_bgcolor c) [AlignCenter] [n]   releaseXMF f   io $ sync d False   i <- startTimer (swn_fade c)

@@ -18,6 +18,7 @@                                -- $usage                                 spacing, Spacing,+                               smartSpacing, SmartSpacing,                               ) where @@ -52,3 +53,17 @@  shrinkRect :: Int -> Rectangle -> Rectangle shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (w-2*fi p) (h-2*fi p)++-- | Surrounds all windows with blank space, except when the window is the only+-- visible window on the current workspace.+smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a+smartSpacing p = ModifiedLayout (SmartSpacing p)++data SmartSpacing a = SmartSpacing Int deriving (Show, Read)++instance LayoutModifier SmartSpacing a where++    pureModifier _ _ _ [x] = ([x], Nothing)+    pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)++    modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p

@@ -26,7 +26,7 @@                             ) where  import Data.Ratio-import XMonad+import XMonad hiding ( Rotation ) import XMonad.StackSet ( integrate )  -- $usage

@@ -45,7 +45,7 @@   instance LayoutModifier TrackFloating Window where-    modifyLayoutWithUpdate os@(TrackFloating wasF mw) ws@(W.Workspace{ W.stack = ms }) r+    modifyLayoutWithUpdate os@(TrackFloating _wasF mw) ws@(W.Workspace{ W.stack = ms }) r       = do         winset <- gets windowset         let xCur = fmap W.focus xStack@@ -57,7 +57,7 @@             newStack               -- focus is floating, so use the remembered focus point               | Just isF' <- isF,-                isF' || wasF,+                isF',                 Just w <- mw,                 Just s <- ms,                 Just ns <- find ((==) w . W.focus)

@@ -105,7 +105,7 @@ configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))  instance LayoutModifier WindowNavigation Window where-    redoLayout (WindowNavigation conf (I state)) rscr (Just s) origwrs =+    redoLayout (WindowNavigation conf (I st)) rscr (Just s) origwrs =         do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask            [uc,dc,lc,rc] <-                case brightness conf of@@ -120,8 +120,8 @@            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+               pt   = case st 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@@ -130,8 +130,8 @@                wnavigablec = nub $ concatMap                             (\d -> map (\(win,_) -> (win,dirc d)) $                                    take 1 $ navigable d pt wrs) [U,D,R,L]-               wothers = case state of Just (NS _ wo) -> map fst wo-                                       _              -> []+               wothers = case st 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)

@@ -29,21 +29,15 @@                                    WorkspaceDir,                                   ) where -import Prelude hiding (catch)-import Control.Exception 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 ) -econst :: Monad m => a -> IOException -> m a-econst = const . return- -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: --@@ -90,8 +84,7 @@ cleanDir x = scd x >> io getCurrentDirectory  scd :: String -> X ()-scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` econst x)-           catchIO $ setCurrentDirectory x'+scd x = catchIO $ setCurrentDirectory x  changeDir :: XPConfig -> X () changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)

@@ -42,7 +42,7 @@  import Data.Maybe (fromMaybe) import Control.Arrow (second)- + -- $usage -- This module provides a layout which places all windows in a single -- row; the size occupied by each individual window can be increased@@ -80,9 +80,9 @@ zoomRow = ZC ClassEQ emptyZ  -- $noneq--- Haskell's 'Eq' class is usually concerned with structural equality, whereas +-- Haskell's 'Eq' class is usually concerned with structural equality, whereas -- what this layout really wants is for its elements to have a unique identity,--- even across changes. There are cases (such as, importantly, 'Window's) where +-- even across changes. There are cases (such as, importantly, 'Window's) where -- the 'Eq' instance for a type actually does that, but if you want to lay -- out something more exotic than windows and your 'Eq' means something else, -- you can use the following.@@ -92,7 +92,7 @@ -- sure that the layout never has to handle two \"equal\" elements -- at the same time (it won't do any huge damage, but might behave -- a bit strangely).-zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a) +zoomRowWith :: (EQF f a, Show (f a), Read (f a), Show a, Read a)                => f a -> ZoomRow f a zoomRowWith f = ZC f emptyZ @@ -185,7 +185,7 @@  -- * LayoutClass instance -instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) +instance (EQF f a, Show a, Read a, Show (f a), Read (f a))     => LayoutClass (ZoomRow f) a where     description (ZC _ Nothing) = "ZoomRow"     description (ZC _ (Just s)) = "ZoomRow" ++ if full $ W.focus s@@ -197,7 +197,7 @@      doLayout (ZC f zelts) r@(Rectangle _ _ w _) s         = let elts = W.integrate' zelts-              zelts' = mapZ_ (\a -> fromMaybe (E a 1 False) +              zelts' = mapZ_ (\a -> fromMaybe (E a 1 False)                                     $ lookupBy (eq f) a elts) $ Just s               elts' = W.integrate' zelts' @@ -251,7 +251,7 @@         = case fromMessage sm of             Just (Zoom r') -> Just $ ZC f $ setFocus zelts $ E a (r*r') b             Just (ZoomTo r') -> Just $ ZC f $ setFocus zelts $ E a r' b-            Just ZoomFullToggle -> pureMessage (ZC f zelts) +            Just ZoomFullToggle -> pureMessage (ZC f zelts)                                      $ SomeMessage $ ZoomFull $ not b             _ -> Nothing 

@@ -18,20 +18,23 @@       -- $usage       mkXPrompt     , mkXPromptWithReturn+    , mkXPromptWithModes     , amberXPConfig     , defaultXPConfig     , greenXPConfig+    , XPMode     , XPType (..)     , XPPosition (..)     , XPConfig (..)     , XPrompt (..)     , XP-    , defaultXPKeymap+    , defaultXPKeymap, defaultXPKeymap'+    , emacsLikeXPKeymap, emacsLikeXPKeymap'     , quit     , killBefore, killAfter, startOfLine, endOfLine     , pasteString, moveCursor     , setInput, getInput-    , moveWord, killWord, deleteString+    , moveWord, moveWord', killWord, killWord', deleteString     , moveHistory, setSuccess, setDone     , Direction1D(..)     , ComplFunction@@ -65,31 +68,29 @@     , XPState     ) where -import Prelude hiding (catch)--import XMonad  hiding (config, cleanMask)-import qualified XMonad as X (numberlockMask)-import qualified XMonad.StackSet as W-import XMonad.Util.Font-import XMonad.Util.Types-import XMonad.Util.XSelection (getSelection)+import           XMonad                       hiding (cleanMask, config)+import qualified XMonad                       as X (numberlockMask)+import qualified XMonad.StackSet              as W+import           XMonad.Util.Font+import           XMonad.Util.Types+import           XMonad.Util.XSelection       (getSelection) -import Codec.Binary.UTF8.String (decodeString)-import Control.Applicative ((<$>))-import Control.Arrow ((&&&),first)-import Control.Concurrent (threadDelay)-import Control.Exception.Extensible hiding (handle)-import Control.Monad.State-import Data.Bits-import Data.Char (isSpace)-import Data.IORef-import Data.List-import Data.Maybe (fromMaybe)-import Data.Set (fromList, toList)-import System.Directory (getAppUserDataDirectory)-import System.IO-import System.Posix.Files-import qualified Data.Map as M+import           Codec.Binary.UTF8.String     (decodeString,isUTF8Encoded)+import           Control.Applicative          ((<$>))+import           Control.Arrow                (first, (&&&), (***))+import           Control.Concurrent           (threadDelay)+import           Control.Exception.Extensible as E hiding (handle)+import           Control.Monad.State+import           Data.Bits+import           Data.Char                    (isSpace)+import           Data.IORef+import           Data.List+import qualified Data.Map                     as M+import           Data.Maybe                   (fromMaybe)+import           Data.Set                     (fromList, toList)+import           System.Directory             (getAppUserDataDirectory)+import           System.IO+import           System.Posix.Files  -- $usage -- For usage examples see "XMonad.Prompt.Shell",@@ -108,11 +109,12 @@         , screen             :: !Rectangle         , complWin           :: Maybe Window         , complWinDim        :: Maybe ComplWindowDim-        , completionFunction :: String -> IO [String]+        , complIndex         :: !(Int,Int)         , showComplWin       :: Bool+        , operationMode      :: XPOperationMode+        , highlightedCompl   :: Maybe String         , gcon               :: !GC         , fontS              :: !XMonadFont-        , xptype             :: !XPType         , commandHistory     :: W.Stack String         , offset             :: !Int         , config             :: XPConfig@@ -130,6 +132,7 @@         , borderColor       :: String     -- ^ Border color         , promptBorderWidth :: !Dimension -- ^ Border width         , position          :: XPPosition -- ^ Position: 'Top' or 'Bottom'+        , alwaysHighlight   :: !Bool      -- ^ Always highlight an item, overriden to True with multiple modes. This implies having *one* column of autocompletions only.         , height            :: !Dimension -- ^ Window height         , historySize       :: !Int       -- ^ The number of history entries to be saved         , historyFilter     :: [String] -> [String]@@ -138,6 +141,7 @@         , promptKeymap      :: M.Map (KeyMask,KeySym) (XP ())                                          -- ^ Mapping from key combinations to actions         , completionKey     :: KeySym     -- ^ Key that should trigger completion+        , changeModeKey     :: KeySym     -- ^ Key to change mode (when the prompt has multiple modes)         , 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@@ -148,6 +152,9 @@         }  data XPType = forall p . XPrompt p => XPT p+type ComplFunction = String -> IO [String]+type XPMode = XPType+data XPOperationMode = XPSingleMode ComplFunction XPType | XPMultipleModes (W.Stack XPType)  instance Show XPType where     show (XPT p) = showXPrompt p@@ -157,6 +164,8 @@     nextCompletion      (XPT t) = nextCompletion      t     commandToComplete   (XPT t) = commandToComplete   t     completionToCommand (XPT t) = completionToCommand t+    completionFunction  (XPT t) = completionFunction  t+    modeAction          (XPT t) = modeAction          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,@@ -178,11 +187,13 @@     -- printed in the command line when tab is pressed, given the     -- string presently in the command line and the list of     -- completion.+    -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True)     nextCompletion :: t -> String -> [String] -> String     nextCompletion = getNextOfLastWord      -- | This method is used to generate the string to be passed to     -- the completion function.+    -- This function is not used when in multiple modes (because alwaysHighlight in XPConfig is True)     commandToComplete :: t -> String -> String     commandToComplete _ = getLastWord @@ -196,6 +207,22 @@     completionToCommand :: t -> String -> String     completionToCommand _ c = c +    -- | When the prompt has multiple modes, this is the function+    -- used to generate the autocompletion list.+    -- The argument passed to this function is given by `commandToComplete`+    -- The default implementation shows an error message.+    completionFunction :: t -> ComplFunction+    completionFunction t = \_ -> return ["Completions for " ++ (showXPrompt t) ++ " could not be loaded"]++    -- | When the prompt has multiple modes (created with mkXPromptWithModes), this function is called+    -- when the user picks an item from the autocompletion list.+    -- The first argument is the prompt (or mode) on which the item was picked+    -- The first string argument is the autocompleted item's text.+    -- The second string argument is the query made by the user (written in the prompt's buffer).+    -- See XMonad/Actions/Launcher.hs for a usage example.+    modeAction :: t -> String -> String -> X ()+    modeAction _ _ _ = return ()+ data XPPosition = Top                 | Bottom                   deriving (Show,Read)@@ -212,6 +239,7 @@         , promptBorderWidth = 1         , promptKeymap      = defaultXPKeymap         , completionKey     = xK_Tab+        , changeModeKey     = xK_grave         , position          = Bottom         , height            = 18         , historySize       = 256@@ -220,29 +248,29 @@         , autoComplete      = Nothing         , showCompletionOnTab = False         , searchPredicate   = isPrefixOf+        , alwaysHighlight   = False         } greenXPConfig = defaultXPConfig { fgColor = "green", bgColor = "black", promptBorderWidth = 0 } 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 -> KeyMask -> XPState-initState d rw w s compl gc fonts pt h c nm =+initState :: Display -> Window -> Window -> Rectangle -> XPOperationMode+          -> GC -> XMonadFont -> [String] -> XPConfig -> KeyMask -> XPState+initState d rw w s opMode gc fonts h c nm =     XPS { dpy                = d         , rootw              = rw         , win                = w         , screen             = s         , complWin           = Nothing         , complWinDim        = Nothing-        , completionFunction = compl         , showComplWin       = not (showCompletionOnTab c)+        , operationMode      = opMode+        , highlightedCompl   = Nothing         , gcon               = gc         , fontS              = fonts-        , xptype             = XPT pt         , commandHistory     = W.Stack { W.focus = defaultText c                                        , W.up    = []                                        , W.down  = h }+        , complIndex         = (0,0) --(column index, row index), used when `alwaysHighlight` in XPConfig is True         , offset             = length (defaultText c)         , config             = c         , successful         = False@@ -250,6 +278,36 @@         , numlockMask        = nm         } +-- Returns the current XPType+currentXPMode :: XPState -> XPType+currentXPMode st = case operationMode st of+  XPMultipleModes modes -> W.focus modes+  XPSingleMode _ xptype -> xptype++-- When in multiple modes, this function sets the next mode+-- in the list of modes as active+setNextMode :: XPState -> XPState+setNextMode st = case operationMode st of+  XPMultipleModes modes -> case W.down modes of+    [] -> st -- there is no next mode, return same state+    (m:ms) -> let+      currentMode = W.focus modes+      in st { operationMode = XPMultipleModes W.Stack { W.up = [], W.focus = m, W.down = ms ++ [currentMode]}} --set next and move previous current mode to the of the stack+  _ -> st --nothing to do, the prompt's operation has only one mode++-- Returns the highlighted item+highlightedItem :: XPState -> [String] -> Maybe String+highlightedItem st' completions = case complWinDim st' of+  Nothing -> Nothing -- when there isn't any compl win, we can't say how many cols,rows there are+  Just winDim ->+    let+      (_,_,_,_,xx,yy) = winDim+      complMatrix = splitInSubListsAt (length yy) (take (length xx * length yy) completions)+      (col_index,row_index) = (complIndex st')+    in case completions of+      [] -> Nothing+      _ -> Just $ complMatrix !! col_index !! row_index+ -- this would be much easier with functional references command :: XPState -> String command = W.focus . commandHistory@@ -257,6 +315,9 @@ setCommand :: String -> XPState -> XPState setCommand xs s = s { commandHistory = (commandHistory s) { W.focus = xs }} +setHighlightedCompl :: Maybe String -> XPState -> XPState+setHighlightedCompl hc st = st { highlightedCompl = hc}+ -- | Sets the input string to the given value. setInput :: String -> XP () setInput = modify . setCommand@@ -284,23 +345,30 @@   fs <- initXMF (font conf)   numlock <- gets $ X.numberlockMask   let hs = fromMaybe [] $ M.lookup (showXPrompt t) hist-      st = initState d rw w s compl gc fs (XPT t) hs conf numlock+      om = (XPSingleMode compl (XPT t)) --operation mode+      st = initState d rw w s om gc fs hs conf numlock   st' <- io $ execStateT runXP st    releaseXMF fs   io $ freeGC d gc-  if successful st'-    then do-      let prune = take (historySize conf)-      io $ writeHistory $ M.insertWith-                                (\xs ys -> prune . historyFilter conf $ xs ++ ys)-                                (showXPrompt t)-                                (prune $ historyFilter conf [command st'])-                                hist+  if successful st' then do+    let+      prune = take (historySize conf)++    io $ writeHistory $ M.insertWith+      (\xs ys -> prune . historyFilter conf $ xs ++ ys)+      (showXPrompt t)+      (prune $ historyFilter conf [command st'])+      hist                                 -- we need to apply historyFilter before as well, since                                 -- otherwise the filter would not be applied if                                 -- there is no history-      Just <$> action (command st')+      --When alwaysHighlight is True, autocompletion is handled with indexes.+      --When it is false, it is handled depending on the prompt buffer's value+    let selectedCompletion = case alwaysHighlight (config st') of+          False -> command st'+          True -> fromMaybe "" $ highlightedCompl st'+    Just <$> action selectedCompletion     else return Nothing  -- | Creates a prompt given:@@ -317,6 +385,60 @@ mkXPrompt :: XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () mkXPrompt t conf compl action = mkXPromptWithReturn t conf compl action >> return () +-- | Creates a prompt with multiple modes given:+--+-- * A non-empty list of modes+-- * A prompt configuration+--+-- The created prompt allows to switch between modes with `changeModeKey` in `conf`. The modes are+-- instances of XPrompt. See XMonad.Actions.Launcher for more details+--+-- The argument supplied to the action to execute is always the current highlighted item,+-- that means that this prompt overrides the value `alwaysHighlight` for its configuration to True.+mkXPromptWithModes :: [XPType] -> XPConfig -> X ()+mkXPromptWithModes modes conf = do+  XConf { display = d, theRoot = rw } <- ask+  s    <- gets $ screenRect . W.screenDetail . W.current . windowset+  hist <- io readHistory+  w    <- io $ createWin d rw conf s+  io $ selectInput d w $ exposureMask .|. keyPressMask+  gc <- io $ createGC d w+  io $ setGraphicsExposures d gc False+  fs <- initXMF (font conf)+  numlock <- gets $ X.numberlockMask+  let+    defaultMode = head modes+    hs = fromMaybe [] $ M.lookup (showXPrompt defaultMode) hist+    modeStack = W.Stack{ W.focus = defaultMode --current mode+                       , W.up = []+                       , W.down = tail modes --other modes+                       }+    st = initState d rw w s (XPMultipleModes modeStack) gc fs hs conf { alwaysHighlight = True} numlock+  st' <- io $ execStateT runXP st++  releaseXMF fs+  io $ freeGC d gc++  if successful st' then do+    let+      prune = take (historySize conf)++      -- insert into history the buffers value+    io $ writeHistory $ M.insertWith+      (\xs ys -> prune . historyFilter conf $ xs ++ ys)+      (showXPrompt defaultMode)+      (prune $ historyFilter conf [command st'])+      hist++    case operationMode st' of+      XPMultipleModes ms -> let+        action = modeAction $ W.focus ms+        in action (command st') $ (fromMaybe "" $ highlightedCompl st')+      _ -> error "The impossible occurred: This prompt runs with multiple modes but they could not be found." --we are creating a prompt with multiple modes, so its operationMode should have been constructed with XPMultipleMode+    else+      return ()++ runXP :: XP () runXP = do   (d,w) <- gets (dpy &&& win)@@ -358,11 +480,16 @@ handle :: KeyStroke -> Event -> XP () handle ks@(sym,_) e@(KeyEvent {ev_event_type = t, ev_state = m}) = do   complKey <- gets $ completionKey . config+  chgModeKey <- gets $ changeModeKey . config   c <- getCompletions   when (length c > 1) $ modify (\s -> s { showComplWin = True })   if complKey == sym      then completionHandle c ks e-     else when (t == keyPress) $ keyPressHandle m ks+     else if (sym == chgModeKey) then+           do+             modify setNextMode+             updateWindows+          else when (t == keyPress) $ keyPressHandle m ks handle _ (ExposeEvent {ev_window = w}) = do   st <- get   when (win st == w) updateWindows@@ -372,15 +499,20 @@ completionHandle ::  [String] -> KeyStroke -> Event -> XP () completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = do   complKey <- gets $ completionKey . config+  alwaysHlight <- gets $ alwaysHighlight . config   case () of     () | t == keyPress && sym == complKey ->           do             st <- get-            let updateState l =-                    let new_command = nextCompletion (xptype st) (command st) l-                    in modify $ \s -> setCommand new_command $ s { offset = length new_command }-                updateWins  l = redrawWindows l >>-                                eventLoop (completionHandle l)+            let updateState l = case alwaysHlight of+                  -- modify the buffer's value+                  False -> let newCommand = nextCompletion (currentXPMode st) (command st) l+                           in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand}+                  --TODO: Scroll or paginate results+                  True -> let complIndex' = nextComplIndex st (length l)+                              highlightedCompl' = highlightedItem st { complIndex = complIndex'} c+                          in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' }+                updateWins l = redrawWindows l >> eventLoop (completionHandle l)             case c of               []  -> updateWindows   >> eventLoop handle               [x] -> updateState [x] >> getCompletions >>= updateWins@@ -390,6 +522,23 @@ -- some other event: go back to main loop completionHandle _ k e = handle k e +--Receives an state of the prompt, the size of the autocompletion list and returns the column,row+--which should be highlighted next+nextComplIndex :: XPState -> Int -> (Int,Int)+nextComplIndex st nitems = case complWinDim st of+  Nothing -> (0,0) --no window dims (just destroyed or not created)+  Just (_,_,_,_,_,yy) -> let+    (ncols,nrows) = (nitems `div` length yy + if (nitems `mod` length yy > 0) then 1 else 0, length yy)+    (currentcol,currentrow) = complIndex st+    in if (currentcol + 1 >= ncols) then --hlight is in the last column+         if (currentrow + 1 < nrows ) then --hlight is still not at the last row+           (currentcol, currentrow + 1)+         else+           (0,0)+       else if(currentrow + 1 < nrows) then --hlight not at the last row+              (currentcol, currentrow + 1)+            else+              (currentcol + 1, 0)  tryAutoComplete :: XP Bool tryAutoComplete = do@@ -402,7 +551,7 @@         Nothing    -> return False   where runCompleted cmd delay = do             st <- get-            let new_command = nextCompletion (xptype st) (command st) [cmd]+            let new_command = nextCompletion (currentXPMode st) (command st) [cmd]             modify $ setCommand "autocompleting..."             updateWindows             io $ threadDelay delay@@ -411,19 +560,31 @@  -- KeyPresses +-- | Default key bindings for prompts.  Click on the \"Source\" link+--   to the right to see the complete list.  See also 'defaultXPKeymap''. defaultXPKeymap :: M.Map (KeyMask,KeySym) (XP ())-defaultXPKeymap = M.fromList $+defaultXPKeymap = defaultXPKeymap' isSpace++-- | A variant of 'defaultXPKeymap' which lets you specify a custom+--   predicate for identifying non-word characters, which affects all+--   the word-oriented commands (move\/kill word).  The default is+--   'isSpace'.  For example, by default a path like @foo\/bar\/baz@+--   would be considered as a single word.  You could use a predicate+--   like @(\\c -> isSpace c || c == \'\/\')@ to move through or+--   delete components of the path one at a time.+defaultXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())+defaultXPKeymap' p = M.fromList $   map (first $ (,) controlMask) -- control + <key>   [ (xK_u, killBefore)   , (xK_k, killAfter)   , (xK_a, startOfLine)   , (xK_e, endOfLine)   , (xK_y, pasteString)-  , (xK_Right, moveWord Next)-  , (xK_Left, moveWord Prev)-  , (xK_Delete, killWord Next)-  , (xK_BackSpace, killWord Prev)-  , (xK_w, killWord Prev)+  , (xK_Right, moveWord' p Next)+  , (xK_Left, moveWord' p Prev)+  , (xK_Delete, killWord' p Next)+  , (xK_BackSpace, killWord' p Prev)+  , (xK_w, killWord' p Prev)   , (xK_g, quit)   , (xK_bracketleft, quit)   ] ++@@ -441,6 +602,57 @@   , (xK_Escape, quit)   ] +-- | A keymap with many emacs-like key bindings.  Click on the+--   \"Source\" link to the right to see the complete list.+--   See also 'emacsLikeXPKeymap''.+emacsLikeXPKeymap :: M.Map (KeyMask,KeySym) (XP ())+emacsLikeXPKeymap = emacsLikeXPKeymap' isSpace++-- | A variant of 'emacsLikeXPKeymap' which lets you specify a custom+--   predicate for identifying non-word characters, which affects all+--   the word-oriented commands (move\/kill word).  The default is+--   'isSpace'.  For example, by default a path like @foo\/bar\/baz@+--   would be considered as a single word.  You could use a predicate+--   like @(\\c -> isSpace c || c == \'\/\')@ to move through or+--   delete components of the path one at a time.+emacsLikeXPKeymap' :: (Char -> Bool) -> M.Map (KeyMask,KeySym) (XP ())+emacsLikeXPKeymap' p = M.fromList $+  map (first $ (,) controlMask) -- control + <key>+  [ (xK_z, killBefore) --kill line backwards+  , (xK_k, killAfter) -- kill line fowards+  , (xK_a, startOfLine) --move to the beginning of the line+  , (xK_e, endOfLine) -- move to the end of the line+  , (xK_d, deleteString Next) -- delete a character foward+  , (xK_b, moveCursor Prev) -- move cursor forward+  , (xK_f, moveCursor Next) -- move cursor backward+  , (xK_BackSpace, killWord' p Prev) -- kill the previous word+  , (xK_y, pasteString)+  , (xK_g, quit)+  , (xK_bracketleft, quit)+  ] +++  map (first $ (,) mod1Mask) -- meta key + <key>+  [ (xK_BackSpace, killWord' p Prev)+  , (xK_f, moveWord' p Next) -- move a word forward+  , (xK_b, moveWord' p Prev) -- move a word backward+  , (xK_d, killWord' p Next) -- kill the next word+  , (xK_n, moveHistory W.focusUp')+  , (xK_p, moveHistory W.focusDown')+  ]+  +++  map (first $ (,) 0) -- <key>+  [ (xK_Return, setSuccess True >> setDone True)+  , (xK_KP_Enter, setSuccess True >> setDone True)+  , (xK_BackSpace, deleteString Prev)+  , (xK_Delete, deleteString Next)+  , (xK_Left, moveCursor Prev)+  , (xK_Right, moveCursor Next)+  , (xK_Home, startOfLine)+  , (xK_End, endOfLine)+  , (xK_Down, moveHistory W.focusUp')+  , (xK_Up, moveHistory W.focusDown')+  , (xK_Escape, quit)+  ]+ keyPressHandle :: KeyMask -> KeyStroke -> XP () keyPressHandle m (ks,str) = do   km <- gets (promptKeymap . config)@@ -450,8 +662,12 @@     Nothing -> case str of                  "" -> eventLoop handle                  _ -> when (kmask .&. controlMask == 0) $ do-                                 insertString (decodeString str)+                                 let str' = if isUTF8Encoded str+                                               then decodeString str+                                               else str+                                 insertString str'                                  updateWindows+                                 updateHighlightedCompl                                  completed <- tryAutoComplete                                  when completed $ setSuccess True >> setDone True @@ -477,16 +693,26 @@ killAfter =   modify $ \s -> setCommand (take (offset s) (command s)) s --- | Kill the next\/previous word+-- | Kill the next\/previous word, using 'isSpace' as the default+--   predicate for non-word characters.  See 'killWord''. killWord :: Direction1D -> XP ()-killWord d = do+killWord = killWord' isSpace++-- | Kill the next\/previous word, given a predicate to identify+--   non-word characters. First delete any consecutive non-word+--   characters; then delete consecutive word characters, stopping+--   just before the next non-word character.+--+--   For example, by default (using 'killWord') a path like+--   @foo\/bar\/baz@ would be deleted in its entirety.  Instead you can+--   use something like @killWord' (\\c -> isSpace c || c == \'\/\')@ to+--   delete the path one component at a time.+killWord' :: (Char -> Bool) -> Direction1D -> XP ()+killWord' p 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+      delNextWord   = snd . break p . dropWhile p       delPrevWord   = reverse . delNextWord . reverse       (ncom,noff)   =           case d of@@ -508,10 +734,18 @@ flushString :: XP () flushString = modify $ \s -> setCommand "" $ s { offset = 0} +--reset index if config has `alwaysHighlight`. The inserted char could imply fewer autocompletions.+--If the current index was column 2, row 1 and now there are only 4 autocompletion rows with 1 column, what should we highlight? Set it to the first and start navigation again+resetComplIndex :: XPState -> XPState+resetComplIndex st = if (alwaysHighlight $ config st) then st { complIndex = (0,0) } else st+ -- | 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)}+  modify $ \s -> let+    cmd = (c (command s) (offset s))+    st = resetComplIndex $ s { offset = o (offset s)}+    in setCommand cmd st   where o oo = oo + length str         c oc oo | oo >= length oc = oc ++ str                 | otherwise = f ++ str ++ ss@@ -539,19 +773,25 @@   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+-- | Move the cursor one word, using 'isSpace' as the default+--   predicate for non-word characters.  See 'moveWord''. moveWord :: Direction1D -> XP ()-moveWord d = do+moveWord = moveWord' isSpace++-- | Move the cursor one word, given a predicate to identify non-word+--   characters. First move past any consecutive non-word characters;+--   then move to just before the next non-word character.+moveWord' :: (Char -> Bool) -> Direction1D -> XP ()+moveWord' p 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+      len = uncurry (+)+          . (length *** (length . fst . break p))+          . break (not . p)       newoff = case d of-                 Prev -> o - ln reverse f-                 Next -> o + ln id ss+                 Prev -> o - len (reverse f)+                 Next -> o + len ss   modify $ \s -> s { offset = newoff }  moveHistory :: (W.Stack String -> W.Stack String) -> XP ()@@ -559,6 +799,13 @@                                in s { commandHistory = ch                                     , offset         = length $ W.focus ch } +updateHighlightedCompl :: XP ()+updateHighlightedCompl = do+  st <- get+  cs <- getCompletions+  alwaysHighlight' <- gets $ alwaysHighlight . config+  when (alwaysHighlight') $ modify $ \s -> s {highlightedCompl = highlightedItem st cs}+ -- X Stuff  updateWindows :: XP ()@@ -611,7 +858,7 @@ printPrompt drw = do   st <- get   let (gc,(c,(d,fs))) = (gcon &&& config &&& dpy &&& fontS) st-      (prt,(com,off)) = (show . xptype &&& command &&& offset) st+      (prt,(com,off)) = (show . currentXPMode &&& 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@@ -633,13 +880,18 @@   -- reverse the colors and print the rest of the string   draw (fgColor c) (bgColor c) (x + fromIntegral (fsl + psl)) y ss --- Completions+-- get the current completion function depending on the active mode+getCompletionFunction :: XPState -> ComplFunction+getCompletionFunction st = case operationMode st of+  XPSingleMode compl _ -> compl+  XPMultipleModes modes -> completionFunction $ W.focus modes +-- Completions getCompletions :: XP [String] getCompletions = do   s <- get-  io $ completionFunction s (commandToComplete (xptype s) (command s))-       `catch` \(SomeException _) -> return []+  io $ getCompletionFunction s (commandToComplete (currentXPMode s) (command s))+       `E.catch` \(SomeException _) -> return []  setComplWin :: Window -> ComplWindowDim -> XP () setComplWin w wi =@@ -713,7 +965,9 @@                          (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+  --lift $ spawn $ "xmessage " ++ " ac: " ++ show ac  ++ " xx: " ++ show xx ++ " length xx: " ++ show (length xx) ++ " yy: " ++ show (length yy)   io $ copyArea d p w gc 0 0 wh ht 0 0   io $ freePixmap d p @@ -734,16 +988,34 @@             Nothing -> recreate      else destroyComplWin +-- Finds the column and row indexes in which a string appears.+-- if the string is not in the matrix, the indexes default to (0,0)+findComplIndex :: String -> [[String]] -> (Int,Int)+findComplIndex x xss = let+  colIndex = fromMaybe 0 $ findIndex (\cols -> x `elem` cols) xss+  rowIndex = fromMaybe 0 $ elemIndex x $ (!!) xss colIndex+  in (colIndex,rowIndex)+ printComplList :: Display -> Drawable -> GC -> String -> String                -> [Position] -> [Position] -> [[String]] -> XP () printComplList d drw gc fc bc xs ys sss =     zipWithM_ (\x ss ->-        zipWithM_ (\y s -> do+        zipWithM_ (\y item -> do             st <- get-            let (f,b) = if completionToCommand (xptype st) s == commandToComplete (xptype st) (command st)-                            then (fgHLight $ config st,bgHLight $ config st)-                            else (fc,bc)-            printStringXMF d drw (fontS st) gc f b x y s)+            alwaysHlight <- gets $ alwaysHighlight . config+            let (f,b) = case alwaysHlight of+                  True -> -- default to the first item, the one in (0,0)+                    let+                      (colIndex,rowIndex) = findComplIndex item sss+                    in -- assign some colors+                     if ((complIndex st) == (colIndex,rowIndex)) then (fgHLight $ config st,bgHLight $ config st)+                     else (fc,bc)+                  False ->+                    -- compare item with buffer's value+                    if completionToCommand (currentXPMode st) item == commandToComplete (currentXPMode st) (command st)+                    then (fgHLight $ config st,bgHLight $ config st)+                    else (fc,bc)+            printStringXMF d drw (fontS st) gc f b x y item)         ys ss) xs sss  -- History@@ -757,7 +1029,7 @@ getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad"  readHistory :: IO History-readHistory = readHist `catch` \(SomeException _) -> return emptyHistory+readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory  where     readHist = do         path <- getHistoryFile@@ -768,7 +1040,7 @@ writeHistory hist = do   path <- getHistoryFile   let filtered = M.filter (not . null) hist-  writeFile path (show filtered) `catch` \(SomeException e) ->+  writeFile path (show filtered) `E.catch` \(SomeException e) ->                           hPutStrLn stderr ("error writing history: "++show e)   setFileMode path mode     where mode = ownerReadMode .|. ownerWriteMode

@@ -24,8 +24,7 @@     , DirExec     ) where -import Prelude hiding (catch)-import Control.Exception+import Control.Exception as E import System.Directory import Control.Monad import Data.List@@ -104,4 +103,4 @@             liftM2 (&&)                 (doesFileExist x')                 (liftM executable (getPermissions x'))))-    `catch` econst []+    `E.catch` econst []

@@ -26,8 +26,7 @@ import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Util.Run (runProcessWithInput) -import Prelude hiding (catch)-import Control.Exception+import Control.Exception as E import Control.Monad (liftM, liftM2) import System.Directory (doesDirectoryExist, doesFileExist, executable, getPermissions) @@ -71,7 +70,7 @@ isApp x = liftM2 (==) pid $ pidof x  pidof :: String -> Query Int-pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `catch` econst 0+pidof x = io $ (runProcessWithInput "pidof" [x] [] >>= readIO) `E.catch` econst 0  pid :: Query Int pid = ask >>= (\w -> liftX $ withDisplay $ \d -> getPID d w)

@@ -15,27 +15,31 @@       -- $usage       Shell (..)     , shellPrompt+    -- ** Variations on shellPrompt+    -- $spawns+    , prompt+    , safePrompt+    , unsafePrompt++    -- * Utility functions     , getCommands     , getBrowser     , getEditor     , getShellCompl     , split-    , prompt-    , safePrompt     ) where -import Codec.Binary.UTF8.String (encodeString)-import Control.Exception-import Control.Monad (forM)-import Data.List (isPrefixOf)-import Prelude hiding (catch)-import System.Directory (doesDirectoryExist, getDirectoryContents)-import System.Environment (getEnv)-import System.Posix.Files (getFileStatus, isDirectory)+import           Codec.Binary.UTF8.String (encodeString)+import           Control.Exception        as E+import           Control.Monad            (forM)+import           Data.List                (isPrefixOf)+import           System.Directory         (doesDirectoryExist, getDirectoryContents)+import           System.Environment       (getEnv)+import           System.Posix.Files       (getFileStatus, isDirectory) -import XMonad.Util.Run-import XMonad hiding (config)-import XMonad.Prompt+import           XMonad                   hiding (config)+import           XMonad.Prompt+import           XMonad.Util.Run  econst :: Monad m => a -> IOException -> m a econst = const . return@@ -64,7 +68,9 @@     cmds <- io getCommands     mkXPrompt Shell c (getShellCompl cmds) spawn -{- | See safe and unsafeSpawn. prompt is an alias for safePrompt;+{- $spawns+    See safe and unsafeSpawn in "XMonad.Util.Run".+    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@@ -78,6 +84,7 @@     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@@ -103,7 +110,7 @@  getCommands :: IO [String] getCommands = do-    p  <- getEnv "PATH" `catch` econst []+    p  <- getEnv "PATH" `E.catch` econst []     let ds = filter (/= "") $ split ':' p     es <- forM ds $ \d -> do         exists <- doesDirectoryExist d@@ -130,9 +137,11 @@ isSpecialChar :: Char -> Bool isSpecialChar =  flip elem " &\\@\"'#?$*()[]{};" --- | Ask the shell environment for+-- | Ask the shell environment for the value of a variable in XMonad's environment, with a default value.+--   In order to /set/ an environment variable (eg. combine with a prompt so you can modify @$HTTP_PROXY@ dynamically),+--   you need to use 'System.Posix.putEnv'. env :: String -> String -> IO String-env variable fallthrough = getEnv variable `catch` econst fallthrough+env variable fallthrough = getEnv variable `E.catch` econst 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

@@ -19,15 +19,13 @@       Ssh,     ) where -import Prelude hiding (catch)- import XMonad import XMonad.Util.Run import XMonad.Prompt  import System.Directory import System.Environment-import Control.Exception+import Control.Exception as E  import Control.Monad import Data.Maybe@@ -78,7 +76,7 @@  sshComplListGlobal :: IO [String] sshComplListGlobal = do-  env <- getEnv "SSH_KNOWN_HOSTS" `catch` econst "/nonexistent"+  env <- getEnv "SSH_KNOWN_HOSTS" `E.catch` econst "/nonexistent"   fs <- mapM fileExists [ env                         , "/usr/local/etc/ssh/ssh_known_hosts"                         , "/usr/local/etc/ssh_known_hosts"

@@ -0,0 +1,140 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  XMonad.Util.DebugWindow+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2012+-- License     :  BSD3-style (see LICENSE)+--+-- Maintainer  :  allbery.b@gmail.com+-- Stability   :  unstable+-- Portability :  not portable+--+-- Module to dump window information for diagnostic/debugging purposes.  See +-- "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.+--+-----------------------------------------------------------------------------++module XMonad.Util.DebugWindow (debugWindow) where++import           Prelude++import           XMonad++import           Codec.Binary.UTF8.String        (decodeString)+import           Control.Exception.Extensible as E+import           Control.Monad                   (when)+import           Data.List                       (unfoldr+                                                 ,intercalate+                                                 )+import           Foreign+import           Foreign.C.String+import           Numeric                         (showHex)+import           System.Exit++-- | Output a window by ID in hex, decimal, its ICCCM resource name and class,+--   and its title if available.  Also indicate override_redirect with an+--   exclamation mark, and wrap in brackets if it is unmapped or withdrawn.+debugWindow   :: Window -> X String+debugWindow 0 =  return "None"+debugWindow w =  do+  let wx = pad 8 '0' $ showHex w ""+  w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)+  case w' of+    Nothing                                   ->+      return $ "(deleted window " ++ wx ++ ")"+    Just (WindowAttributes x y wid ht bw m o) -> do+      c' <- withDisplay $ \d ->+            io (getWindowProperty8 d wM_CLASS w)+      let c = case c' of+                Nothing -> ""+                Just c''  -> intercalate "/" $+                             flip unfoldr (map (toEnum . fromEnum) c'') $+                             \s -> if null s+                                     then Nothing+                                     else let (w'',s'') = break (== '\NUL') s+                                              s'      = if null s''+                                                          then s''+                                                          else tail s''+                                          in Just (w'',s')+      t <- catchX' (wrap `fmap` getEWMHTitle  "VISIBLE" w) $+           catchX' (wrap `fmap` getEWMHTitle  ""        w) $+           catchX' (wrap `fmap` getICCCMTitle           w) $+           return ""+      let (lb,rb) = case () of+                      () | m == waIsViewable -> ("","")+                         | otherwise         -> ("[","]")+          o'      = if o then "!" else ""+      return $ concat [lb+                      ,o'+                      ,"window "+                      ,wx+                      ,t+                      ," ("+                      ,show wid+                      ,',':show ht+                      ,')':if bw == 0 then "" else '+':show bw+                      ,"@("+                      ,show x+                      ,',':show y+                      ,')':if null c then "" else ' ':c+                      ,rb+                      ]++getEWMHTitle       :: String -> Window -> X String+getEWMHTitle sub w =  do+  a <- getAtom $ "_NET_WM_" ++ (if null sub then "" else '_':sub) ++ "_NAME"+  (Just t) <- withDisplay $ \d -> io $ getWindowProperty32 d a w+  return $ map (toEnum . fromEnum) t++getICCCMTitle   :: Window -> X String+getICCCMTitle w =  do+  t@(TextProperty t' _ 8 _) <- withDisplay $ \d -> io $ getTextProperty d w wM_NAME+  [s] <- catchX' (tryUTF8     t) $+         catchX' (tryCompound t) $+         io ((:[]) `fmap` peekCString t')+  return s++tryUTF8                          :: TextProperty -> X [String]+tryUTF8 (TextProperty s enc _ _) =  do+  uTF8_STRING <- getAtom "UTF8_STRING"+  when (enc == uTF8_STRING) $ error "String is not UTF8_STRING"+  (map decodeString . splitNul) `fmap` io (peekCString s)++tryCompound                            :: TextProperty -> X [String]+tryCompound t@(TextProperty _ enc _ _) =  do+  cOMPOUND_TEXT <- getAtom "COMPOUND_TEXT"+  when (enc == cOMPOUND_TEXT) $ error "String is not COMPOUND_TEXT"+  withDisplay $ \d -> io $ wcTextPropertyToTextList d t++splitNul    :: String -> [String]+splitNul "" =  []+splitNul s  =  let (s',ss') = break (== '\NUL') s in s' : splitNul ss'++pad       :: Int -> Char -> String -> String+pad w c s =  replicate (w - length s) c ++ s++-- modified 'catchX' without the print to 'stderr'+catchX' :: X a -> X a -> X a+catchX' job errcase = do+  st <- get+  c <- ask+  (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of+    Just x -> throw e `const` (x `asTypeOf` ExitSuccess)+    _ -> runX c st errcase+  put s'+  return a++wrap   :: String -> String+wrap s =  ' ' : '"' : wrap' s ++ "\""+  where+    wrap' (s':ss) | s' == '"'  = '\\' : s' : wrap' ss+                  | s' == '\\' = '\\' : s' : wrap' ss+                  | otherwise  =        s' : wrap' ss+    wrap' ""                   =             ""++-- Graphics.X11.Extras.getWindowAttributes is bugggggggy+safeGetWindowAttributes     :: Display -> Window -> IO (Maybe WindowAttributes)+safeGetWindowAttributes d w =  alloca $ \p -> do+  s <- xGetWindowAttributes d w p+  case s of+    0 -> return Nothing+    _ -> Just `fmap` peek p

@@ -55,7 +55,7 @@  -- | Like 'menu' but also takes a list of command line arguments. menuArgs :: String -> [String] -> [String] -> X String-menuArgs menuCmd args opts = runProcessWithInput menuCmd args (unlines opts)+menuArgs menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts)  -- | Like 'dmenuMap' but also takes the command to run. menuMap :: String -> M.Map String a -> X (Maybe a)

@@ -32,11 +32,10 @@     , fi     ) where -import Prelude hiding (catch) import XMonad import Foreign import Control.Applicative-import Control.Exception+import Control.Exception as E import Data.Maybe  #ifdef XFT@@ -53,7 +52,7 @@ #endif  -- $usage--- See "Xmonad.Layout.Tabbed" or "XMonad.Prompt" for usage examples+-- 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.@@ -70,7 +69,7 @@ initCoreFont :: String -> X FontStruct initCoreFont s = do   d <- asks display-  io $ catch (getIt d) (fallBack d)+  io $ E.catch (getIt d) (fallBack d)       where getIt    d = loadQueryFont d s             fallBack d = econst $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" @@ -82,7 +81,7 @@ initUtf8Font :: String -> X FontSet initUtf8Font s = do   d <- asks display-  (_,_,fs) <- io $ catch (getIt d) (fallBack d)+  (_,_,fs) <- io $ E.catch (getIt d) (fallBack d)   return fs       where getIt    d = createFontSet d s             fallBack d = econst $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"

@@ -29,7 +29,7 @@                  | CenterLeft Int        -- ^ Centered in the y-axis, an amount of pixels from the left                  | CenterRight Int       -- ^ Centered in the y-axis, an amount of pixels from the right                    deriving (Show, Read)-                   + -- $usage -- This module uses matrices of boolean values as images. When drawing them, -- a True value tells that we want the fore color, and a False value that we

@@ -52,9 +52,8 @@ import XMonad.Util.Font (Align (..)) import XMonad.Util.NamedWindows (getName) -import Prelude hiding (catch) import Control.Applicative ((<$>))-import Control.Exception+import Control.Exception as E import Data.List (isPrefixOf, isSuffixOf) import Data.Maybe (fromMaybe) import Data.Traversable (traverse)@@ -143,7 +142,7 @@ -- | Create a 'Logger' from an arbitrary shell command. logCmd :: String -> Logger logCmd c = io $ do (_, out, _, _) <- runInteractiveCommand c-                   fmap Just (hGetLine out) `catch` econst Nothing+                   fmap Just (hGetLine out) `E.catch` econst Nothing                    -- no need to waitForProcess, we ignore SIGCHLD  -- | Get a count of filtered files in a directory.

@@ -24,12 +24,14 @@   namedScratchpadAction,   allNamedScratchpadAction,   namedScratchpadManageHook,-  namedScratchpadFilterOutWorkspace+  namedScratchpadFilterOutWorkspace,+  namedScratchpadFilterOutWorkspacePP   ) where  import XMonad import XMonad.Hooks.ManageHelpers (doRectFloat) import XMonad.Actions.DynamicWorkspaces (addHiddenWorkspace)+import XMonad.Hooks.DynamicLog (PP, ppSort)  import Control.Monad (filterM) import Data.Maybe (listToMaybe)@@ -159,5 +161,21 @@ -- doesn't contain it. Intended for use with logHooks. namedScratchpadFilterOutWorkspace :: [WindowSpace] -> [WindowSpace] namedScratchpadFilterOutWorkspace = filter (\(W.Workspace tag _ _) -> tag /= scratchpadWorkspaceTag)++-- | Transforms a pretty-printer into one not displaying the NSP workspace.+--+-- A simple use could be:+--+-- > logHook = dynamicLogWithPP . namedScratchpadFilterOutWorkspace $ defaultPP+--+-- Here is another example, when using "XMonad.Layout.IndependentScreens".+-- If you have handles @hLeft@ and @hRight@ for bars on the left and right screens, respectively, and @pp@ is a pretty-printer function that takes a handle, you could write+--+-- > logHook = let log screen handle = dynamicLogWithPP . namedScratchpadFilterOutWorkspacePP . marshallPP screen . pp $ handle+-- >           in log 0 hLeft >> log 1 hRight+namedScratchpadFilterOutWorkspacePP :: PP -> PP+namedScratchpadFilterOutWorkspacePP pp = pp {+  ppSort = fmap (. namedScratchpadFilterOutWorkspace) (ppSort pp)+  }  -- vim:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:

@@ -22,9 +22,8 @@                                    unName                                   ) where -import Prelude hiding ( catch ) import Control.Applicative ( (<$>) )-import Control.Exception.Extensible ( bracket, catch, SomeException(..) )+import Control.Exception.Extensible as E import Data.Maybe ( fromMaybe, listToMaybe )  import qualified XMonad.StackSet as W ( peek )@@ -50,11 +49,11 @@     let getIt = bracket getProp (xFree . tp_value) (fmap (`NW` w) . copy)          getProp = (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)-                      `catch` \(SomeException _) -> getTextProperty d w wM_NAME+                      `E.catch` \(SomeException _) -> getTextProperty d w wM_NAME          copy prop = fromMaybe "" . listToMaybe <$> wcTextPropertyToTextList d prop -    io $ getIt `catch` \(SomeException _) ->  ((`NW` w) . resName) `fmap` getClassHint d w+    io $ getIt `E.catch` \(SomeException _) ->  ((`NW` w) . resName) `fmap` getClassHint d w  unName :: NamedWindow -> Window unName (NW _ w) = w

@@ -3,7 +3,7 @@ Copyright   :  (C) 2008 Jérémy Bobbio, gwern License     :  BSD3 -Maintainer  :  gwern <gwern0@gmail.com>+Maintainer  :  none Stability   :  unstable Portability :  unportable @@ -54,9 +54,9 @@ pasteSelection = getSelection >>= pasteString  -- | Send a string to the window which is currently focused. This function correctly--- handles capitalization.+-- handles capitalization. Warning: in dealing with capitalized characters, this assumes a QWERTY layout. pasteString :: String -> X ()-pasteString = mapM_ (\x -> if isUpper x then pasteChar shiftMask x else pasteChar noModMask x)+pasteString = mapM_ (\x -> if isUpper x || x `elem` "~!@#$%^&*()_+{}|:\"<>?" 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.@@ -89,9 +89,3 @@                   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

@@ -86,6 +86,15 @@ -- Use like: -- -- > (5.5 `seconds`)+--+-- In GHC 7 and later, you must either enable the PostfixOperators extension+-- (by adding+--+-- > {-# LANGUAGE PostfixOperators #-}+--+-- to the top of your file) or use seconds in prefix form:+--+-- > 5.5 seconds seconds :: Rational -> Int seconds = fromEnum . (* 1000000) 

@@ -145,7 +145,7 @@ swapDownZ :: Zipper a -> Zipper a swapDownZ Nothing = Nothing swapDownZ (Just s) | d:down <- W.down s = Just s { W.down = down, W.up = d:W.up s }-swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) } +swapDownZ (Just s) = Just s { W.up = [], W.down = reverse (W.up s) }  -- | Swap the focused element with the first one swapMasterZ :: Zipper a -> Zipper a@@ -197,7 +197,7 @@     where adapt g e1 e2 = g (fromE e1) (fromE e2)  -- ** Maps-             + -- | Map a function over a stack. The boolean argument indcates whether -- the current element is the focused one mapZ :: (Bool -> a -> b) -> Zipper a -> Zipper b

@@ -131,12 +131,12 @@                                                }              } --- | Don's prefered colors - from DynamicLog...;)+-- | Don's preferred colors - from DynamicLog...;) donaldTheme  :: ThemeInfo donaldTheme =     newTheme { themeName        = "donaldTheme"              , themeAuthor      = "Andrea Rossato"-             , themeDescription = "Don's prefered colors - from DynamicLog...;)"+             , themeDescription = "Don's preferred colors - from DynamicLog...;)"              , theme            = defaultTheme { activeColor         = "#2b4f98"                                                , inactiveColor       = "#cccccc"                                                , activeBorderColor   = "#2b4f98"

@@ -82,7 +82,7 @@ safePromptSelection app = join $ io $ liftM (safeSpawn app . return) 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 +{- | 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

@@ -38,7 +38,7 @@ import Control.Monad  -- $usage--- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or +-- See "XMonad.Layout.Tabbed" or "XMonad.Layout.DragPane" or -- "XMonad.Layout.Decoration" for usage examples  -- | Compute the weighted average the colors of two given Pixel values.@@ -163,7 +163,7 @@ -- drawn inside it. -- Not exported. paintWindow' :: Window -> Rectangle -> Dimension -> String -> String-                -> Maybe (XMonadFont,String,String,[(String, (Position, Position))]) +                -> Maybe (XMonadFont,String,String,[(String, (Position, Position))])                 -> Maybe (String, String, [((Position, Position), [[Bool]])]) -> X () paintWindow' win (Rectangle _ _ wh ht) bw color b_color strStuff iconStuff = do   d  <- asks display

@@ -1,5 +1,5 @@ name:               xmonad-contrib-version:            0.10+version:            0.11 homepage:           http://xmonad.org/ synopsis:           Third party extensions for xmonad description:@@ -30,9 +30,20 @@                     tests/Selective.hs                     tests/SwapWorkspaces.hs                     tests/XPrompt.hs-cabal-version:      >= 1.2.1+cabal-version:      >= 1.6 build-type:         Simple+bug-reports:        http://code.google.com/p/xmonad/issues/list +tested-with:        GHC==7.6.1,+                    GHC==7.4.1,+                    GHC==7.2.1,+                    GHC==6.12.3,+                    GHC==6.10.4+source-repository head+  type:     darcs+  location: http://code.haskell.org/XMonadContrib++ flag small_base   description: Choose the new smaller, split-up base package. @@ -61,7 +72,7 @@         extensions: ForeignFunctionInterface         cpp-options: -DXFT -    build-depends:      mtl >= 1 && < 3, unix, X11>=1.5.0.0 && < 1.6, xmonad>=0.10, xmonad<0.11, utf8-string+    build-depends:      mtl >= 1 && < 3, unix, X11>=1.6 && < 1.7, xmonad>=0.11   && < 0.12, utf8-string      if true         ghc-options:    -fwarn-tabs -Wall@@ -102,9 +113,11 @@                         XMonad.Actions.FocusNth                         XMonad.Actions.GridSelect                         XMonad.Actions.GroupNavigation+                        XMonad.Actions.Launcher                         XMonad.Actions.MessageFeedback                         XMonad.Actions.MouseGestures                         XMonad.Actions.MouseResize+                        XMonad.Actions.Navigation2D                         XMonad.Actions.NoBorders                         XMonad.Actions.OnScreen                         XMonad.Actions.PerWorkspaceKeys@@ -115,6 +128,7 @@                         XMonad.Actions.KeyRemap                         XMonad.Actions.RotSlaves                         XMonad.Actions.Search+                        XMonad.Actions.ShowText                         XMonad.Actions.SimpleDate                         XMonad.Actions.SinkAll                         XMonad.Actions.SpawnOn@@ -132,6 +146,7 @@                         XMonad.Actions.WithAll                         XMonad.Actions.WorkspaceCursors                         XMonad.Actions.WorkspaceNames+                        XMonad.Actions.Workscreen                         XMonad.Config.Arossato                         XMonad.Config.Azerty                         XMonad.Config.Bluetile@@ -142,9 +157,12 @@                         XMonad.Config.Sjanssen                         XMonad.Config.Xfce                         XMonad.Hooks.CurrentWorkspaceOnTop+                        XMonad.Hooks.DebugEvents                         XMonad.Hooks.DebugKeyEvents+                        XMonad.Hooks.DynamicBars                         XMonad.Hooks.DynamicHooks                         XMonad.Hooks.DynamicLog+                        XMonad.Hooks.DebugStack                         XMonad.Hooks.EwmhDesktops                         XMonad.Hooks.FadeInactive                         XMonad.Hooks.FadeWindows@@ -221,6 +239,7 @@                         XMonad.Layout.Named                         XMonad.Layout.NoBorders                         XMonad.Layout.NoFrillsDecoration+                        XMonad.Layout.OnHost                         XMonad.Layout.OneBig                         XMonad.Layout.PerWorkspace                         XMonad.Layout.PositionStoreFloat@@ -268,6 +287,7 @@                         XMonad.Prompt.XMonad                         XMonad.Util.Cursor                         XMonad.Util.CustomKeys+                        XMonad.Util.DebugWindow                         XMonad.Util.Dmenu                         XMonad.Util.Dzen                         XMonad.Util.ExtensibleState