From 3147065b3ff8d0cade905909aa29946378298f76 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Fri, 9 Nov 2012 02:41:56 +0100 Subject: Remove trailing whitespace. Ignore-this: 72e3afb6e6df47c51262006601765365 darcs-hash:20121109014156-1499c-45797b245e25e966e4ca337ee224b593aaac63a0.gz --- XMonad/Layout/Groups.hs | 38 +++++++++++++++++----------------- XMonad/Layout/Groups/Examples.hs | 18 ++++++++-------- XMonad/Layout/Groups/Helpers.hs | 6 +++--- XMonad/Layout/Groups/Wmii.hs | 22 ++++++++++---------- XMonad/Layout/ImageButtonDecoration.hs | 2 +- XMonad/Layout/LayoutBuilderP.hs | 2 +- XMonad/Layout/Renamed.hs | 2 +- XMonad/Layout/ZoomRow.hs | 14 ++++++------- 8 files changed, 52 insertions(+), 52 deletions(-) (limited to 'XMonad/Layout') diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index e1236ab..e5ea977 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -70,9 +70,9 @@ import Control.Monad (forM) -- 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 @@ import Control.Monad (forM) -- 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 @@ group l l2 = Groups l l2 startingGroups (U 1 0) 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 @@ gen (U i1 i2) = (U (i1+1) i2, zipWith U (repeat i1) [i2..]) -- | 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,15 +133,15 @@ instance Eq (WithID l a) where ID id1 _ == ID id2 _ = id1 == id2 instance LayoutClass l a => LayoutClass (WithID l) a where - runLayout ws@W.Workspace { W.layout = ID id l } r - = do (placements, ml') <- flip runLayout r + 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 @@ modifyGroups f g = let (seed', id:_) = gen (seed g) -- | 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 :: Eq a => Zipper a -> Zipper a -> Zipper a removeDeleted z = filterZ_ (flip elemZ z) -- | Identify the windows not already in a group. -findNewWindows :: Eq a => [a] -> Zipper (Group l a) +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 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) 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 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window)) 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 @@ refocus g = case getFocusZ $ gZipper $ W.focus $ groups g -- ** 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,7 +358,7 @@ refocus g = case getFocusZ $ gZipper $ W.focus $ groups g -- '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. @@ -367,7 +367,7 @@ applySpec f g = let (seed', id:ids) = gen $ seed g 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 @@ _removeFocused (W.Stack f [] []) = (f, Nothing) -- 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 @@ _moveToNewGroup l0 s insertX | G l (Just f) <- W.focus s 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 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 -- () 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 diff --git a/XMonad/Layout/ImageButtonDecoration.hs b/XMonad/Layout/ImageButtonDecoration.hs index cab72fd..0a44fe7 100644 --- a/XMonad/Layout/ImageButtonDecoration.hs +++ b/XMonad/Layout/ImageButtonDecoration.hs @@ -140,7 +140,7 @@ closeButton' = [[1,1,0,0,0,0,0,0,1,1], 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. diff --git a/XMonad/Layout/LayoutBuilderP.hs b/XMonad/Layout/LayoutBuilderP.hs index aee6c6a..b76f3d9 100644 --- a/XMonad/Layout/LayoutBuilderP.hs +++ b/XMonad/Layout/LayoutBuilderP.hs @@ -40,7 +40,7 @@ import qualified XMonad.Layout.LayoutBuilder as B -- -- 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 diff --git a/XMonad/Layout/Renamed.hs b/XMonad/Layout/Renamed.hs index 5d55b86..002a725 100644 --- a/XMonad/Layout/Renamed.hs +++ b/XMonad/Layout/Renamed.hs @@ -24,7 +24,7 @@ import XMonad import XMonad.Layout.LayoutModifier -- $usage --- You can use this module by adding +-- You can use this module by adding -- -- > import XMonad.Layout.Renamed -- diff --git a/XMonad/Layout/ZoomRow.hs b/XMonad/Layout/ZoomRow.hs index c279bba..6f86726 100644 --- a/XMonad/Layout/ZoomRow.hs +++ b/XMonad/Layout/ZoomRow.hs @@ -42,7 +42,7 @@ import XMonad.Layout.Decoration (fi) 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 :: (Eq a, Show a, Read a) => ZoomRow ClassEQ a 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 @@ zoomRow = ZC ClassEQ emptyZ -- 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 @@ zoomReset = ZoomTo 1 -- * 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 @@ instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) 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 @@ instance (EQF f a, Show a, Read a, Show (f a), Read (f a)) = 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 -- cgit v1.2.3