aboutsummaryrefslogtreecommitdiffstats
path: root/XMonad/Layout/Groups
diff options
context:
space:
mode:
authorAdam Vogt <vogt.adam@gmail.com>2012-11-09 02:41:56 +0100
committerAdam Vogt <vogt.adam@gmail.com>2012-11-09 02:41:56 +0100
commit3147065b3ff8d0cade905909aa29946378298f76 (patch)
tree7a3b0d4a08853e43b3ee95873466cefb2b48c567 /XMonad/Layout/Groups
parent7f324e08476792e522987867c0f8098eeb0e50e0 (diff)
downloadXMonadContrib-3147065b3ff8d0cade905909aa29946378298f76.tar.gz
XMonadContrib-3147065b3ff8d0cade905909aa29946378298f76.tar.xz
XMonadContrib-3147065b3ff8d0cade905909aa29946378298f76.zip
Remove trailing whitespace.
Ignore-this: 72e3afb6e6df47c51262006601765365 darcs-hash:20121109014156-1499c-45797b245e25e966e4ca337ee224b593aaac63a0.gz
Diffstat (limited to 'XMonad/Layout/Groups')
-rw-r--r--XMonad/Layout/Groups/Examples.hs18
-rw-r--r--XMonad/Layout/Groups/Helpers.hs6
-rw-r--r--XMonad/Layout/Groups/Wmii.hs22
3 files changed, 23 insertions, 23 deletions
diff --git a/XMonad/Layout/Groups/Examples.hs b/XMonad/Layout/Groups/Examples.hs
index a5d1770..9407c9b 100644
--- a/XMonad/Layout/Groups/Examples.hs
+++ b/XMonad/Layout/Groups/Examples.hs
@@ -67,12 +67,12 @@ import XMonad.Layout.Simplest
-- $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 @@ import XMonad.Layout.Simplest
-- 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 @@ data GroupEQ a = GroupEQ
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 @@ toggleWindowFull = sendMessage ZoomFullToggle
-- $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 @@ data TiledTabsConfig s = TTC { vNMaster :: Int
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
diff --git a/XMonad/Layout/Groups/Helpers.hs b/XMonad/Layout/Groups/Helpers.hs
index 972f357..268ab72 100644
--- a/XMonad/Layout/Groups/Helpers.hs
+++ b/XMonad/Layout/Groups/Helpers.hs
@@ -69,7 +69,7 @@ import qualified Data.Map as M
-- 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 @@ ifFloat x1 x2 = withFocused $ \w -> do floats <- getFloats
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 @@ focusNonFloatDown = alt2 (G.Modify G.focusDown) $ focusHelper not id
focusFloatUp :: X ()
focusFloatUp = focusHelper id reverse
-
+
focusFloatDown :: X ()
focusFloatDown = focusHelper id id
diff --git a/XMonad/Layout/Groups/Wmii.hs b/XMonad/Layout/Groups/Wmii.hs
index 92297fe..da45149 100644
--- a/XMonad/Layout/Groups/Wmii.hs
+++ b/XMonad/Layout/Groups/Wmii.hs
@@ -17,7 +17,7 @@
module XMonad.Layout.Groups.Wmii ( -- * Usage
-- $usage
-
+
wmii
, zoomGroupIn
, zoomGroupOut
@@ -48,9 +48,9 @@ import XMonad.Layout.Simplest
-- $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 @@ import XMonad.Layout.Simplest
--
-- * 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 @@ import XMonad.Layout.Simplest
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