From 477ac70445bcebc96d76a73dd1bee50e990f9391 Mon Sep 17 00:00:00 2001 From: Adam Vogt Date: Thu, 18 Jun 2009 02:37:29 +0200 Subject: Correct many typos in the documentation, consistent US spellingg Ignore-this: cf6dcf340fa6cc010f7879f188d376f5 darcs-hash:20090618003729-1499c-c927c08cda268b94b350f6419a64df8ca1e863d4.gz --- XMonad/Actions/Plane.hs | 4 ++-- XMonad/Actions/TopicSpace.hs | 2 +- XMonad/Actions/UpdateFocus.hs | 2 +- XMonad/Hooks/Place.hs | 16 +++++++------- XMonad/Hooks/Script.hs | 2 +- XMonad/Layout/ComboP.hs | 2 +- XMonad/Layout/DecorationMadness.hs | 4 ++-- XMonad/Layout/IM.hs | 2 +- XMonad/Layout/LayoutHints.hs | 44 +++++++++++++++++++------------------- XMonad/Layout/Master.hs | 2 +- XMonad/Layout/OneBig.hs | 2 +- XMonad/Layout/ShowWName.hs | 2 +- XMonad/Layout/StackTile.hs | 2 +- XMonad/Layout/SubLayouts.hs | 2 +- XMonad/Layout/ThreeColumns.hs | 2 +- XMonad/Layout/WindowArranger.hs | 2 +- XMonad/Layout/WindowNavigation.hs | 6 ++---- XMonad/Util/EZConfig.hs | 4 ++-- XMonad/Util/Font.hsc | 2 +- XMonad/Util/Run.hs | 2 +- XMonad/Util/Scratchpad.hs | 2 +- 21 files changed, 53 insertions(+), 55 deletions(-) diff --git a/XMonad/Actions/Plane.hs b/XMonad/Actions/Plane.hs index c99ed74..8126d41 100644 --- a/XMonad/Actions/Plane.hs +++ b/XMonad/Actions/Plane.hs @@ -78,9 +78,9 @@ data Limits -- divisor, the last line will have the remaining workspaces. data Lines = GConf -- ^ Use @gconftool-2@ to find out the number of lines. - | Lines Int -- ^ Specify the number of lines explicity. + | Lines Int -- ^ Specify the number of lines explicitly. --- | This is the way most people would like to use this module. It ataches the +-- | This is the way most people would like to use this module. It attaches the -- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and -- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'. -- It also associates these bindings with 'shiftMask' to 'planeShift'. diff --git a/XMonad/Actions/TopicSpace.hs b/XMonad/Actions/TopicSpace.hs index c20c22d..547d143 100644 --- a/XMonad/Actions/TopicSpace.hs +++ b/XMonad/Actions/TopicSpace.hs @@ -19,7 +19,7 @@ -- attach your mail client to the mail topic, some terminals in the right -- directory to the xmonad topic... This package also provides a nice way to -- display your topics in an historical way using a custom `pprWindowSet' --- function. You can also easily switch to recents topics using this history +-- function. You can also easily switch to recent topics using this history -- of last focused topics. -- -- Here is an example of configuration using TopicSpace: diff --git a/XMonad/Actions/UpdateFocus.hs b/XMonad/Actions/UpdateFocus.hs index fb51ea3..c92d66c 100644 --- a/XMonad/Actions/UpdateFocus.hs +++ b/XMonad/Actions/UpdateFocus.hs @@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- | --- Module : XMonadContrib.UpdateFocus +-- Module : XMonad.Actions.UpdateFocus -- Copyright : (c) Daniel Schoepe -- License : BSD3-style (see LICENSE) -- diff --git a/XMonad/Hooks/Place.hs b/XMonad/Hooks/Place.hs index c0b92ee..9211f93 100644 --- a/XMonad/Hooks/Place.hs +++ b/XMonad/Hooks/Place.hs @@ -407,29 +407,29 @@ position rs x y w h = minimumBy distanceOrder $ map closest rs -- | First part of the algorithm: -- Tries to find an area in which to place a new -- rectangle so that it overlaps as little as possible with --- other rectangles aready present. The first rectangles in +-- other rectangles already present. The first rectangles in -- the list will be overlapped first. findSpace :: Real a => SmartRectangle a -- ^ The total available area - -> [SmartRectangle a] -- ^ The parts aready in use + -> [SmartRectangle a] -- ^ The parts already in use -> a -- ^ Width of the rectangle to place -> a -- ^ Height of the rectangle to place -> [SmartRectangle a] findSpace total [] _ _ = [total] findSpace total rs@(_:rs') w h - = case filter largeEnough $ cleanup $ substractRects total rs of + = case filter largeEnough $ cleanup $ subtractRects total rs of [] -> findSpace total rs' w h as -> as where largeEnough r = width r >= w && height r >= h --- | Substracts smaller rectangles from a total rectangle +-- | Subtracts smaller rectangles from a total rectangle -- , returning a list of remaining rectangular areas. -substractRects :: Real a => SmartRectangle a +subtractRects :: Real a => SmartRectangle a -> [SmartRectangle a] -> [SmartRectangle a] -substractRects total [] = [total] -substractRects total (r:rs) - = do total' <- substractRects total rs +subtractRects total [] = [total] +subtractRects total (r:rs) + = do total' <- subtractRects total rs filter (not . isEmpty) [ total' {sr_y1 = min (sr_y1 total') (sr_y0 r)} -- Above , total' {sr_x0 = max (sr_x0 total') (sr_x1 r)} -- Right diff --git a/XMonad/Hooks/Script.hs b/XMonad/Hooks/Script.hs index 1df2637..ef6bc10 100644 --- a/XMonad/Hooks/Script.hs +++ b/XMonad/Hooks/Script.hs @@ -43,7 +43,7 @@ import System.Directory -- > ... -- > } -- --- Now, everytime the startup hook runs, the command +-- Now, every time the startup hook runs, the command -- @~\/.xmonad\/hooks startup@ will also. -- | Execute a named script hook diff --git a/XMonad/Layout/ComboP.hs b/XMonad/Layout/ComboP.hs index 3ad6e02..e84e2b7 100644 --- a/XMonad/Layout/ComboP.hs +++ b/XMonad/Layout/ComboP.hs @@ -53,7 +53,7 @@ import qualified XMonad.StackSet as W -- the property will go into the first part, all others will go into the second -- part. It supports @Move@ messages as 'combineTwo' does, but it also introduces -- 'SwapWindow' message which sends focused window to the other part. It is --- required becase @Move@ commands don't work when one of the parts is empty. +-- required because @Move@ commands don't work when one of the parts is empty. -- To use it, import \"XMonad.Layout.WindowNavigation\", and add the following key -- bindings (or something similar): -- diff --git a/XMonad/Layout/DecorationMadness.hs b/XMonad/Layout/DecorationMadness.hs index 6a616a3..91ae7bb 100644 --- a/XMonad/Layout/DecorationMadness.hs +++ b/XMonad/Layout/DecorationMadness.hs @@ -127,8 +127,8 @@ import XMonad.Layout.SimpleFloat -- up the key bindings, please read the documentation of -- "XMonad.Layout.WindowArranger" -- --- The deafult theme can be dynamically change with the xmonad theme --- selector. See "XMonad.Prompt.Theme". For more themse, look at +-- The default theme can be dynamically change with the xmonad theme +-- selector. See "XMonad.Prompt.Theme". For more themes, look at -- "XMonad.Util.Themes" -- $circle diff --git a/XMonad/Layout/IM.hs b/XMonad/Layout/IM.hs index ba342d3..2a27700 100644 --- a/XMonad/Layout/IM.hs +++ b/XMonad/Layout/IM.hs @@ -10,7 +10,7 @@ -- Stability : unstable -- Portability : unportable -- --- Layout modfier suitable for workspace with multi-windowed instant messanger +-- Layout modfier suitable for workspace with multi-windowed instant messenger -- (like Psi or Tkabber). -- ----------------------------------------------------------------------------- diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index 7419573..5925972 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -18,7 +18,7 @@ module XMonad.Layout.LayoutHints -- $usage layoutHints , layoutHintsWithPlacement - , layoutHintsToCentre + , layoutHintsToCenter , LayoutHints ) where @@ -57,7 +57,7 @@ import qualified Data.Set as Set -- -- Or, to make a reasonable attempt to eliminate gaps between windows: -- --- > myLayouts = layoutHintsToCentre (Tall 1 (3/100) (1/2)) +-- > myLayouts = layoutHintsToCenter (Tall 1 (3/100) (1/2)) -- -- For more detailed instructions on editing the layoutHook see: -- @@ -75,16 +75,16 @@ layoutHintsWithPlacement :: (LayoutClass l a) => (Double, Double) -> l a -> ModifiedLayout LayoutHints l a layoutHintsWithPlacement rs = ModifiedLayout (LayoutHints rs) --- | @layoutHintsToCentre layout@ applies hints, sliding the window to the --- centre of the screen and expanding its neighbours to fill the gaps. Windows +-- | @layoutHintsToCenter layout@ applies hints, sliding the window to the +-- center of the screen and expanding its neighbors to fill the gaps. Windows -- are never expanded in a way that increases overlap. -- --- @layoutHintsToCentre@ only makes one pass at resizing the neighbours of --- hinted windows, so with some layouts (ex. the arrangment with two 'Mirror' --- 'Tall' stacked vertically), @layoutHintsToCentre@ may leave some gaps. +-- @layoutHintsToCenter@ only makes one pass at resizing the neighbors of +-- hinted windows, so with some layouts (ex. the arrangement with two 'Mirror' +-- 'Tall' stacked vertically), @layoutHintsToCenter@ may leave some gaps. -- Simple layouts like 'Tall' are unaffected. -layoutHintsToCentre :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCentre l a -layoutHintsToCentre = ModifiedLayout LayoutHintsToCentre +layoutHintsToCenter :: (LayoutClass l a) => l a -> ModifiedLayout LayoutHintsToCenter l a +layoutHintsToCenter = ModifiedLayout LayoutHintsToCenter data LayoutHints a = LayoutHints (Double, Double) deriving (Read, Show) @@ -121,14 +121,14 @@ applyOrder root wrs = do -- resizing multiple times f <- [maximum, minimum, sum, sum . map sq] return $ sortBy (compare `on` (f . distance)) wrs - where distFC = uncurry ((+) `on` sq) . pairWise (-) (centre root) + where distFC = uncurry ((+) `on` sq) . pairWise (-) (center root) distance = map distFC . corners . snd pairWise f (a,b) (c,d) = (f a c, f b d) sq = join (*) -data LayoutHintsToCentre a = LayoutHintsToCentre deriving (Read, Show) +data LayoutHintsToCenter a = LayoutHintsToCenter deriving (Read, Show) -instance LayoutModifier LayoutHintsToCentre Window where +instance LayoutModifier LayoutHintsToCenter Window where modifyLayout _ ws@(W.Workspace _ _ Nothing) r = runLayout ws r modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do (arrs,ol) <- runLayout ws r @@ -142,7 +142,7 @@ applyHints _ _ [] = return [] applyHints s root ((w,lrect@(Rectangle a b c d)):xs) = do adj <- mkAdjust w let (c',d') = adj (c,d) - redr = placeRectangle (centrePlacement root lrect :: (Double,Double)) lrect + redr = placeRectangle (centerPlacement root lrect :: (Double,Double)) lrect $ if isInStack s w then Rectangle a b c' d' else lrect ds = (fromIntegral c - fromIntegral c',fromIntegral d - fromIntegral d') @@ -208,12 +208,12 @@ corners (Rectangle x y w h) = [(x,y) ,(x+fromIntegral w, y+fromIntegral h) ,(x, y+fromIntegral h)] -centre :: Rectangle -> (Position, Position) -centre (Rectangle x y w h) = (avg x w, avg y h) +center :: Rectangle -> (Position, Position) +center (Rectangle x y w h) = (avg x w, avg y h) where avg a b = a + fromIntegral b `div` 2 -centrePlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) -centrePlacement = centrePlacement' clamp +centerPlacement :: RealFrac r => Rectangle -> Rectangle -> (r, r) +centerPlacement = centerPlacement' clamp where clamp n = case signum n of 0 -> 0.5 1 -> 1 @@ -221,7 +221,7 @@ centrePlacement = centrePlacement' clamp freeDirs :: Rectangle -> Rectangle -> Set Direction freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) - . centrePlacement' signum root + . centerPlacement' signum root where lr 1 = [L] lr (-1) = [R] @@ -230,8 +230,8 @@ freeDirs root = Set.fromList . uncurry (++) . (lr *** ud) ud (-1) = [D] ud _ = [U,D] -centrePlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) -centrePlacement' cf root assigned +centerPlacement' :: (Position -> r) -> Rectangle -> Rectangle -> (r, r) +centerPlacement' cf root assigned = (cf $ cx - cwx, cf $ cy - cwy) - where (cx,cy) = centre root - (cwx,cwy) = centre assigned + where (cx,cy) = center root + (cwx,cwy) = center assigned diff --git a/XMonad/Layout/Master.hs b/XMonad/Layout/Master.hs index 2fcce18..1d470c0 100644 --- a/XMonad/Layout/Master.hs +++ b/XMonad/Layout/Master.hs @@ -47,7 +47,7 @@ import XMonad.Layout.LayoutModifier -- layout data AddMaster a = AddMaster Rational Rational deriving (Show, Read) --- | Modifier wich converts given layout to a mastered one +-- | Modifier which converts given layout to a mastered one mastered :: (LayoutClass l a) => Rational -- ^ @delta@, the ratio of the screen to resize by -> Rational -- ^ @frac@, what portion of the screen to use for the master window diff --git a/XMonad/Layout/OneBig.hs b/XMonad/Layout/OneBig.hs index 365dfb4..73f1adb 100644 --- a/XMonad/Layout/OneBig.hs +++ b/XMonad/Layout/OneBig.hs @@ -27,7 +27,7 @@ import qualified XMonad.StackSet as W -- bottom of master. It tries to give equal space for each slave -- window. -- --- You can use this module by adding folowing in your @xmonad.hs@: +-- You can use this module by adding following in your @xmonad.hs@: -- -- > import XMonad.Layout.OneBig -- diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs index b9e1586..c010843 100644 --- a/XMonad/Layout/ShowWName.hs +++ b/XMonad/Layout/ShowWName.hs @@ -45,7 +45,7 @@ showWName :: l a -> ModifiedLayout ShowWName l a showWName = ModifiedLayout (SWN True defaultSWNConfig Nothing) -- | A layout modifier to show the workspace name when switching. It --- is possible to provide a costum configuration. +-- is possible to provide a custom configuration. showWName' :: SWNConfig -> l a -> ModifiedLayout ShowWName l a showWName' c = ModifiedLayout (SWN True c Nothing) diff --git a/XMonad/Layout/StackTile.hs b/XMonad/Layout/StackTile.hs index 3df7e35..5090dcc 100644 --- a/XMonad/Layout/StackTile.hs +++ b/XMonad/Layout/StackTile.hs @@ -12,7 +12,7 @@ -- Portability : unportable -- -- A stacking layout, like dishes but with the ability to resize master pane. --- Mostly usefull on small screens. +-- Mostly useful on small screens. -- ----------------------------------------------------------------------------- diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index b4a3c8f..e98a936 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -67,7 +67,7 @@ import Data.Map(Map) -- styles. Better compatibility with some other layouts of which I am not -- aware could be another benefit. -- --- 'simpleTabbed' (and other decorated layouts) fail horibly when used as +-- 'simpleTabbed' (and other decorated layouts) fail horribly when used as -- subLayouts: -- -- * decorations stick around: layout is run after being told to Hide diff --git a/XMonad/Layout/ThreeColumns.hs b/XMonad/Layout/ThreeColumns.hs index 5db95b7..4140537 100644 --- a/XMonad/Layout/ThreeColumns.hs +++ b/XMonad/Layout/ThreeColumns.hs @@ -41,7 +41,7 @@ import Control.Monad -- > myLayouts = ThreeCol 1 (3/100) (1/2) ||| ThreeColMid 1 (3/100) (1/2) ||| etc.. -- > main = xmonad defaultConfig { layoutHook = myLayouts } -- --- The first argument specifies hom many windows initially appear in the main +-- The first argument specifies how many windows initially appear in the main -- window. The second argument argument specifies the amount to resize while -- resizing and the third argument specifies the initial size of the columns. -- A positive size designates the fraction of the screen that the main window diff --git a/XMonad/Layout/WindowArranger.hs b/XMonad/Layout/WindowArranger.hs index 7af39f0..2548096 100644 --- a/XMonad/Layout/WindowArranger.hs +++ b/XMonad/Layout/WindowArranger.hs @@ -203,7 +203,7 @@ memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b] memberFromList f g l = foldr (h l) [] where h x y ys = if g (f y) x then [y] else ys --- | Get the list of elements to be deleted and the list ef elements to +-- | Get the list of elements to be deleted and the list of elements to -- be added to the first list in order to get the second list. diff :: Eq a => ([a],[a]) -> ([a],[a]) diff (x,y) = (x \\ y, y \\ x) diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs index 219aa37..e8ef796 100644 --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -90,9 +90,7 @@ navigateColor c = WNC Nothing c c c c navigateBrightness :: Double -> WNConfig -navigateBrightness f | f > 1 = navigateBrightness 1 - | f < 0 = navigateBrightness 0 -navigateBrightness f = defaultWNConfig { brightness = Just f } +navigateBrightness f = defaultWNConfig { brightness = Just $ max 0 $ min 1 f } defaultWNConfig :: WNConfig defaultWNConfig = WNC (Just 0.4) "#0000FF" "#00FFFF" "#FF0000" "#FF00FF" @@ -129,7 +127,7 @@ instance LayoutModifier WindowNavigation Window where wrs = filter ((`elem` existing_wins) . fst) $ filter ((/=r) . snd) $ filter ((/=w) . fst) origwrs wnavigable = nub $ concatMap - (\d -> truncHead $ navigable d pt wrs) [U,D,R,L] + (\d -> take 1 $ navigable d pt wrs) [U,D,R,L] wnavigablec = nub $ concatMap (\d -> map (\(win,_) -> (win,dirc d)) $ truncHead $ navigable d pt wrs) [U,D,R,L] diff --git a/XMonad/Util/EZConfig.hs b/XMonad/Util/EZConfig.hs index b1c1bc5..59d8067 100644 --- a/XMonad/Util/EZConfig.hs +++ b/XMonad/Util/EZConfig.hs @@ -56,7 +56,7 @@ import Text.ParserCombinators.ReadP -- provided, suitable for adding to your 'startupHook', which can warn -- you of any parse errors or duplicate bindings in your keymap. -- --- For more information and usage eamples, see the documentation +-- For more information and usage examples, see the documentation -- provided with each exported function, and check the xmonad config -- archive () -- for some real examples of use. @@ -220,7 +220,7 @@ removeMouseBindings conf mouseBindingList = -- > - -- -- Long list of multimedia keys. Please note that not all keys may be --- present in your particular setup althrough most likely they will do. +-- present in your particular setup although most likely they will do. -- -- > -- > diff --git a/XMonad/Util/Font.hsc b/XMonad/Util/Font.hsc index ea1da07..42de67d 100644 --- a/XMonad/Util/Font.hsc +++ b/XMonad/Util/Font.hsc @@ -91,7 +91,7 @@ releaseUtf8Font fs = do d <- asks display io $ freeFontSet d fs --- | When initXMF gets a font name that starts with 'xft:' it switchs to the Xft backend +-- | When initXMF gets a font name that starts with 'xft:' it switches to the Xft backend -- Example: 'xft: Sans-10' initXMF :: String -> X XMonadFont initXMF s = diff --git a/XMonad/Util/Run.hs b/XMonad/Util/Run.hs index b3f4206..700ee3c 100644 --- a/XMonad/Util/Run.hs +++ b/XMonad/Util/Run.hs @@ -51,7 +51,7 @@ import Control.Monad -- "XMonad.Util.Dzen" -- | Return output if the command succeeded, otherwise return @()@. --- This corresponds to dmenu's notion of exit code 1 for a cancelled invocation. +-- This corresponds to dmenu's notion of exit code 1 for a canceled invocation. runProcessWithInput :: FilePath -> [String] -> String -> IO String runProcessWithInput cmd args input = do (pin, pout, perr, _) <- runInteractiveProcess cmd args Nothing Nothing diff --git a/XMonad/Util/Scratchpad.hs b/XMonad/Util/Scratchpad.hs index 11d4d24..1edcc1d 100644 --- a/XMonad/Util/Scratchpad.hs +++ b/XMonad/Util/Scratchpad.hs @@ -83,7 +83,7 @@ scratchpadSpawnActionTerminal term = scratchpadAction $ spawn $ term ++ " -name scratchpad" --- | Action to pop up any program with the user specifiying how to set +-- | Action to pop up any program with the user specifying how to set -- its resource to \"scratchpad\". For example, with gnome-terminal -- bind the following to a key: -- -- cgit v1.2.3