Apply hlint hints

All hints are applied in one single commit, as a commit per hint would
result in 80+ separate commits—tihs is really just too much noise.

Related: https://github.com/xmonad/xmonad-contrib/issues/537
This commit is contained in:
slotThe 2021-06-06 16:11:17 +02:00
parent b96899afb6
commit bd5b969d9b
222 changed files with 1119 additions and 1193 deletions

View File

@ -42,7 +42,7 @@ import System.Exit
workspaceCommands :: Int -> X [(String, X ())]
workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
[(("greedyView" ++ show i),
[( "greedyView" ++ show i,
activateScreen sid >> windows (W.greedyView i))
| i <- spaces ]
@ -65,7 +65,7 @@ masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
]
quitCommands :: [(String, X ())]
quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
quitCommands = [ ("quit bluetile", io exitSuccess)
, ("quit bluetile and start metacity", restart "metacity" False)
]

View File

@ -61,18 +61,18 @@ import XMonad.Prelude
-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
-- list of pairs.
commandMap :: [(String, X ())] -> M.Map String (X ())
commandMap c = M.fromList c
commandMap = M.fromList
-- | Generate a list of commands to switch to\/send windows to workspaces.
workspaceCommands :: X [(String, X ())]
workspaceCommands = asks (workspaces . config) >>= \spaces -> return
[((m ++ show i), windows $ f i)
[( m ++ show i, windows $ f i)
| i <- spaces
, (f, m) <- [(view, "view"), (shift, "shift")] ]
-- | Generate a list of commands dealing with multiple screens.
screenCommands :: [(String, X ())]
screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
screenCommands = [( m ++ show sc, screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
| sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
, (f, m) <- [(view, "screen"), (shift, "screen-to-")]
]
@ -100,7 +100,7 @@ defaultCommands = do
, ("swap-down" , windows swapDown )
, ("swap-master" , windows swapMaster )
, ("sink" , withFocused $ windows . sink )
, ("quit-wm" , io $ exitWith ExitSuccess )
, ("quit-wm" , io exitSuccess )
]
-- | Given a list of command\/action pairs, prompt the user to choose a

View File

@ -96,7 +96,7 @@ copy n s | Just w <- W.peek s = copyWindow w n s
-- | Copy the focused window to all workspaces.
copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
copyToAll s = foldr (copy . W.tag) s (W.workspaces s)
-- | Copy an arbitrary window to a workspace.
copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
@ -142,9 +142,9 @@ killAllOtherCopies = do ss <- gets windowset
W.view (W.currentTag ss) .
delFromAllButCurrent w
where
delFromAllButCurrent w ss = foldr ($) ss $
map (delWinFromWorkspace w . W.tag) $
W.hidden ss ++ map W.workspace (W.visible ss)
delFromAllButCurrent w ss = foldr (delWinFromWorkspace w . W.tag)
ss
(W.hidden ss ++ map W.workspace (W.visible ss))
delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss

View File

@ -18,7 +18,7 @@ module XMonad.Actions.CycleSelectedLayouts (
cycleThroughLayouts) where
import XMonad
import XMonad.Prelude (findIndex, fromMaybe)
import XMonad.Prelude (elemIndex, fromMaybe)
import qualified XMonad.StackSet as S
-- $usage
@ -32,7 +32,7 @@ import qualified XMonad.StackSet as S
cycleToNext :: (Eq a) => [a] -> a -> Maybe a
cycleToNext lst a = do
-- not beautiful but simple and readable
ind <- findIndex (a==) lst
ind <- elemIndex a lst
return $ lst !! if ind == length lst - 1 then 0 else ind+1
-- | If the current layout is in the list, cycle to the next layout. Otherwise,

View File

@ -199,8 +199,7 @@ skipTags wss ids = filter ((`notElem` ids) . tag) wss
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
lastViewedHiddenExcept skips = do
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
vs <- WH.workspaceHistory
return $ choose hs (find (`elem` hs) vs)
choose hs . find (`elem` hs) <$> WH.workspaceHistory
where choose [] _ = Nothing
choose (h:_) Nothing = Just h
choose _ vh@(Just _) = vh
@ -211,7 +210,7 @@ switchWorkspace d = wsBy d >>= windows . greedyView
shiftBy :: Int -> X ()
shiftBy d = wsBy d >>= windows . shift
wsBy :: Int -> X (WorkspaceId)
wsBy :: Int -> X WorkspaceId
wsBy = findWorkspace getSortByIndex Next AnyWS
{- $taketwo
@ -260,7 +259,7 @@ wsTypeToPred HiddenEmptyWS = do ne <- wsTypeToPred EmptyWS
hi <- wsTypeToPred HiddenWS
return (\w -> hi w && ne w)
wsTypeToPred AnyWS = return (const True)
wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
wsTypeToPred (WSTagGroup sep) = do cur <- groupName.workspace.current <$> gets windowset
return $ (cur ==).groupName
where groupName = takeWhile (/=sep).tag
wsTypeToPred (WSIs p) = p
@ -297,7 +296,7 @@ findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceI
findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
where
maybeNegate Next d = d
maybeNegate Prev d = (-d)
maybeNegate Prev d = -d
findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
@ -307,7 +306,7 @@ findWorkspaceGen sortX wsPredX d = do
ws <- gets windowset
let cur = workspace (current ws)
sorted = sort (workspaces ws)
pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
pivoted = let (a,b) = span ((/= tag cur) . tag) sorted in b ++ a
ws' = filter wsPred pivoted
mCurIx = findWsIndex cur ws'
d' = if d > 0 then d - 1 else d
@ -319,7 +318,7 @@ findWorkspaceGen sortX wsPredX d = do
return $ tag next
findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
findWsIndex ws = findIndex ((== tag ws) . tag)
-- | View next screen
nextScreen :: X ()
@ -347,7 +346,7 @@ the default screen keybindings:
> , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
-}
screenBy :: Int -> X (ScreenId)
screenBy :: Int -> X ScreenId
screenBy d = do ws <- gets windowset
--let ss = sortBy screen (screens ws)
let now = screen (current ws)

View File

@ -116,7 +116,7 @@ cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking t
-- If it's the same as the first key, it is effectively ignored.
-> X ()
cycleRecentWindows = cycleStacks' stacks where
stacks s = map (shiftToFocus' `flip` s) (wins s)
stacks s = map (`shiftToFocus'` s) (wins s)
wins (W.Stack t l r) = t : r ++ reverse l
@ -205,7 +205,7 @@ rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
rotFocused' _ s@(W.Stack _ [] []) = s
rotFocused' f (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
where (t':rs') = f (t:rs)
rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s -- otherwise
rotFocused' f s@W.Stack{} = rotSlaves' f s -- otherwise
-- $unfocused

View File

@ -49,7 +49,7 @@ repeatableAction mods pressHandler = do
return (t, s)
handleEvent (t, s)
| t == keyRelease && s `elem` mods = return ()
| otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent
| otherwise = pressHandler t s >> getNextEvent >>= handleEvent
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
getNextEvent >>= handleEvent
@ -81,9 +81,9 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti
current <- readIORef currentWSIndex
modifyIORef
currentWSIndex
((`mod` (length cycleWorkspaces)) . (+ increment))
((`mod` length cycleWorkspaces) . (+ increment))
return $ cycleWorkspaces !! current
focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)
focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView)
focusIncrement 1 -- Do the first workspace cycle
repeatableAction mods $

View File

@ -44,7 +44,7 @@ import Control.Arrow ((&&&))
import qualified Data.Map as M
import XMonad
import XMonad.Prelude (find)
import XMonad.Prelude (find, for_)
import qualified XMonad.StackSet as W
import XMonad.Prompt
@ -68,14 +68,14 @@ type WSGroup = [(ScreenId,WorkspaceId)]
type WSGroupId = String
data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
newtype WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
deriving (Typeable, Read, Show)
withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
withWSG f = WSG . f . unWSG
instance ExtensionClass WSGroupStorage where
initialValue = WSG $ M.empty
initialValue = WSG M.empty
extensionType = PersistentExtension
-- | Add a new workspace group of the given name, mapping to an
@ -90,9 +90,7 @@ addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
addWSGroup name wids = withWindowSet $ \w -> do
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
wmap = mapM (strength . (flip lookup wss &&& id)) wids
case wmap of
Just ps -> addRawWSGroup name ps
Nothing -> return ()
for_ wmap (addRawWSGroup name)
where strength (ma, b) = ma >>= \a -> return (a,b)
-- | Give a name to the current workspace group.
@ -114,9 +112,8 @@ viewWSGroup = viewGroup (windows . W.greedyView)
viewGroup :: (WorkspaceId -> X ()) -> WSGroupId -> X ()
viewGroup fview name = do
WSG m <- XS.get
case M.lookup name m of
Just grp -> mapM_ (uncurry (viewWS fview)) grp
Nothing -> return ()
for_ (M.lookup name m) $
mapM_ (uncurry (viewWS fview))
-- | View the given workspace on the given screen, using the provided function.
viewWS :: (WorkspaceId -> X ()) -> ScreenId -> WorkspaceId -> X ()
@ -133,7 +130,7 @@ findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
findScreenWS sid = withWindowSet $
return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
data WSGPrompt = WSGPrompt String
newtype WSGPrompt = WSGPrompt String
instance XPrompt WSGPrompt where
showXPrompt (WSGPrompt s) = s

View File

@ -89,7 +89,7 @@ import Data.Ord (comparing)
-- tweak as desired.
-- | Extensible state storage for the workspace order.
data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
newtype WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
deriving (Typeable, Read, Show)
instance ExtensionClass WSOrderStorage where

View File

@ -86,7 +86,7 @@ type WorkspaceIndex = Int
-- | Internal dynamic project state that stores a mapping between
-- workspace indexes and workspace tags.
data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
newtype DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
deriving (Typeable, Read, Show)
instance ExtensionClass DynamicWorkspaceState where
@ -239,14 +239,14 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
return $ maybe True (isNothing . stack) mws
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
addHiddenWorkspace' add newtag l s@StackSet{ hidden = ws } = s { hidden = add (Workspace newtag l Nothing) ws }
-- | Remove the hidden workspace with the given tag from the StackSet, if
-- it exists. All the windows in that workspace are moved to the current
-- workspace.
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
, hidden = hs })
removeWorkspace' torem s@StackSet{ current = scr@Screen { workspace = wc }
, hidden = hs }
= let (xs, ys) = break ((== torem) . tag) hs
in removeWorkspace'' xs ys
where meld Nothing Nothing = Nothing

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
@ -23,8 +23,9 @@ module XMonad.Actions.FlexibleManipulate (
) where
import XMonad
import XMonad.Prelude ((<&>))
import qualified Prelude as P
import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))
-- $usage
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@ -79,9 +80,9 @@ position = const 0.5
-- manipulation action.
mouseWindow :: (Double -> Double) -> Window -> X ()
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
[wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
[wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
sh <- io $ getWMNormalHints d w
pointer <- io $ queryPointer d w >>= return . pointerPos
pointer <- io $ queryPointer d w <&> pointerPos
let uv = (pointer - wpos) / wsize
fc = mapP f uv
@ -112,7 +113,7 @@ type Pnt = (Double, Double)
pairUp :: [a] -> [(a,a)]
pairUp [] = []
pairUp [_] = []
pairUp (x:y:xs) = (x, y) : (pairUp xs)
pairUp (x:y:xs) = (x, y) : pairUp xs
mapP :: (a -> b) -> (a, a) -> (b, b)
mapP f (x, y) = (f x, f y)
@ -131,4 +132,3 @@ infixl 7 *, /
(*) = zipP (P.*)
(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
(/) = zipP (P./)

View File

@ -66,12 +66,12 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
(float w)
where
findPos :: CInt -> Position -> Maybe Bool
findPos m s = if p < 0.5 - edge/2
then Just True
else if p < 0.5 + edge/2
then Nothing
else Just False
where p = fi m / fi s
findPos m s
| p < 0.5 - edge/2 = Just True
| p < 0.5 + edge/2 = Nothing
| otherwise = Just False
where
p = fi m / fi s
mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
mkSel b k p = case b of
Just True -> (0, (fi k + fi p -).fi, (fi k + fi p -).fi)

View File

@ -27,7 +27,7 @@ module XMonad.Actions.FloatSnap (
ifClick') where
import XMonad
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort)
import XMonad.Prelude (fromJust, isNothing, listToMaybe, sort, when)
import qualified XMonad.StackSet as W
import qualified Data.Set as S
@ -94,14 +94,14 @@ snapMagicMouseResize
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
wa <- io $ getWindowAttributes d w
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
let x = (fromIntegral px - wx wa)/(ww wa)
y = (fromIntegral py - wy wa)/(wh wa)
ml = if x <= (0.5 - middle/2) then [L] else []
mr = if x > (0.5 + middle/2) then [R] else []
mu = if y <= (0.5 - middle/2) then [U] else []
md = if y > (0.5 + middle/2) then [D] else []
let x = (fromIntegral px - wx wa)/ww wa
y = (fromIntegral py - wy wa)/wh wa
ml = [L | x <= (0.5 - middle/2)]
mr = [R | x > (0.5 + middle/2)]
mu = [U | y <= (0.5 - middle/2)]
md = [D | y > (0.5 + middle/2)]
mdir = ml++mr++mu++md
dir = if mdir == []
dir = if null mdir
then [L,R,U,D]
else mdir
snapMagicResize dir collidedist snapdist w
@ -124,12 +124,12 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
(xbegin,xend) <- handleAxis True d wa
(ybegin,yend) <- handleAxis False d wa
let xbegin' = if L `elem` dir then xbegin else (wx wa)
xend' = if R `elem` dir then xend else (wx wa + ww wa)
ybegin' = if U `elem` dir then ybegin else (wy wa)
yend' = if D `elem` dir then yend else (wy wa + wh wa)
let xbegin' = if L `elem` dir then xbegin else wx wa
xend' = if R `elem` dir then xend else wx wa + ww wa
ybegin' = if U `elem` dir then ybegin else wy wa
yend' = if D `elem` dir then yend else wy wa + wh wa
io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
io $ moveWindow d w (fromIntegral xbegin') (fromIntegral ybegin')
io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
float w
where
@ -149,13 +149,13 @@ snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $
(Nothing,Nothing) -> wpos wa
end = if fs
then wpos wa + wdim wa
else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
else case (if mfl==Just begin then Nothing else mfl,mfr) of
(Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
(Just fl,Nothing) -> fl
(Nothing,Just fr) -> fr
(Nothing,Nothing) -> wpos wa + wdim wa
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else wpos wa
end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else wpos wa + wdim wa
return (begin',end')
where
(wpos, wdim, _, _) = constructors horiz
@ -190,8 +190,8 @@ snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
(Just fl,Nothing) -> fl
(Nothing,Just fr) -> fr
(Nothing,Nothing) -> wpos wa
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else f - wdim wa
in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else wpos wa
where
(wpos, wdim, _, _) = constructors horiz
@ -268,9 +268,8 @@ snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
case mr of
Nothing -> return ()
Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
Just (nx,ny,nw,nh) -> when (nw>0 && nh>0) $ do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
else return ()
float w
where
wx = fromIntegral.wa_x
@ -286,7 +285,7 @@ getSnap horiz collidedist d w = do
let sr = screenRect $ W.screenDetail screen
wl = W.integrate' . W.stack $ W.workspace screen
gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
wla <- filter (collides wa) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
wla <- filter (collides wa) <$> io (mapM (getWindowAttributes d) $ filter (/=w) wl)
return ( neighbours (back wa sr gr wla) (wpos wa)
, neighbours (front wa sr gr wla) (wpos wa + wdim wa)
@ -300,8 +299,8 @@ getSnap horiz collidedist d w = do
back wa sr gr wla = dropWhile (< rpos sr) $
takeWhile (< rpos sr + rdim sr) $
sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
sort $ rpos sr:rpos gr:(rpos gr + rdim gr):
foldr (\a as -> wpos a:(wpos a + wdim a + wborder a + wborder wa):as) [] wla
front wa sr gr wla = dropWhile (<= rpos sr) $
takeWhile (<= rpos sr + rdim sr) $
@ -315,8 +314,8 @@ getSnap horiz collidedist d w = do
collides wa oa = case collidedist of
Nothing -> True
Just dist -> ( refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
Just dist -> refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
&& refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa
constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)

View File

@ -39,7 +39,7 @@ focusNth :: Int -> X ()
focusNth = windows . modify' . focusNth'
focusNth' :: Int -> Stack a -> Stack a
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length ls + length rs) = s
| otherwise = listToStack n (integrate s)
-- | Swap current window with nth. Focus stays in the same position
@ -52,7 +52,6 @@ swapNth' n s@(Stack c l r)
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
listToStack :: Int -> [a] -> Stack a
listToStack n l = Stack t ls rs
where

View File

@ -1,4 +1,4 @@
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, FlexibleInstances, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.GridSelect
@ -222,7 +222,7 @@ instance HasColorizer String where
instance {-# OVERLAPPABLE #-} HasColorizer a where
defaultColorizer _ isFg =
let getColor = if isFg then focusedBorderColor else normalBorderColor
in asks $ flip (,) "black" . getColor . config
in asks $ (, "black") . getColor . config
instance HasColorizer a => Default (GSConfig a) where
def = buildDefaultGSConfig defaultColorizer
@ -257,7 +257,7 @@ generateElementmap s = do
-- Sorts the elementmap
sortedElements = orderElementmap searchString filteredElements
-- Case Insensitive version of isInfixOf
needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
needle `isInfixOfI` haystack = upper needle `isInfixOf` upper haystack
upper = map toUpper
@ -301,8 +301,8 @@ diamondLayer n =
-- tr = top right
-- r = ur ++ 90 degree clock-wise rotation of ur
let tr = [ (x,n-x) | x <- [0..n-1] ]
r = tr ++ (map (\(x,y) -> (y,-x)) tr)
in r ++ (map (negate *** negate) r)
r = tr ++ map (\(x,y) -> (y,-x)) tr
in r ++ map (negate *** negate) r
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
diamond = concatMap diamondLayer [0..]
@ -332,7 +332,7 @@ drawWinBox win font (fg,bg) bc ch cw text x y cp =
drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
stext <- shrinkWhile (shrinkIt shrinkText)
(\n -> do size <- liftIO $ textWidthXMF dpy font n
return $ size > (fromInteger (cw-(2*cp))))
return $ size > fromInteger (cw-(2*cp)))
text
-- calculate the offset to vertically centre the text based on the ascender and descender
(asc,desc) <- liftIO $ textExtentsXMF font stext
@ -385,7 +385,7 @@ updateElementsWithColorizer colorizer elementmap = do
mapM_ updateElement elementmap
stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
stdHandle ButtonEvent{ ev_event_type = t, ev_x = x, ev_y = y } contEventloop
| t == buttonRelease = do
s@TwoDState { td_paneX = px, td_paneY = py,
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
@ -396,7 +396,7 @@ stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
Nothing -> contEventloop
| otherwise = contEventloop
stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
stdHandle _ contEventloop = contEventloop
@ -443,7 +443,7 @@ setPos newPos = do
oldPos = td_curpos s
when (isJust newSelectedEl && newPos /= oldPos) $ do
put s { td_curpos = newPos }
updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
updateElements (catMaybes [findInElementMap oldPos elmap, newSelectedEl])
-- | Moves the cursor by the offsets specified
move :: (Integer, Integer) -> TwoD a ()
@ -543,7 +543,7 @@ navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDef
,((0,xK_Up) , move (0,-1) >> navNSearch)
,((0,xK_Tab) , moveNext >> navNSearch)
,((shiftMask,xK_Tab), movePrev >> navNSearch)
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> navNSearch)
]
-- The navigation handler ignores unknown key symbols, therefore we const
navNSearchDefaultHandler (_,s,_) = do
@ -557,7 +557,7 @@ substringSearch returnNavigation = fix $ \me ->
let searchKeyMap = M.fromList [
((0,xK_Escape) , transformSearchString (const "") >> returnNavigation)
,((0,xK_Return) , returnNavigation)
,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
,((0,xK_BackSpace), transformSearchString (\s -> if s == "" then "" else init s) >> me)
]
searchDefaultHandler (_,s,_) = do
transformSearchString (++ s)
@ -569,8 +569,8 @@ substringSearch returnNavigation = fix $ \me ->
-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
hsv2rgb (h,s,v) =
let hi = (div h 60) `mod` 6 :: Integer
f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
let hi = div h 60 `mod` 6 :: Integer
f = ((fromInteger h/60) - fromInteger hi) :: Fractional a => a
q = v * (1-f)
p = v * (1-s)
t = v * (1-(1-f)*s)
@ -587,19 +587,19 @@ hsv2rgb (h,s,v) =
stringColorizer :: String -> Bool -> X (String, String)
stringColorizer s active =
let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
(r,g,b) = hsv2rgb ((seed 83) `mod` 360,
(fromInteger ((seed 191) `mod` 1000))/2500+0.4,
(fromInteger ((seed 121) `mod` 1000))/2500+0.4)
(r,g,b) = hsv2rgb (seed 83 `mod` 360,
fromInteger (seed 191 `mod` 1000)/2500+0.4,
fromInteger (seed 121 `mod` 1000)/2500+0.4)
in if active
then return ("#faff69", "black")
else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
else return ("#" ++ concatMap (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b], "white")
-- | Colorize a window depending on it's className.
fromClassName :: Window -> Bool -> X (String, String)
fromClassName w active = runQuery className w >>= flip defaultColorizer active
twodigitHex :: Word8 -> String
twodigitHex a = printf "%02x" a
twodigitHex = printf "%02x"
-- | A colorizer that picks a color inside a range,
-- and depending on the window's class.
@ -655,14 +655,14 @@ gridselect gsconfig elements =
font <- initXMF (gs_font gsconfig)
let screenWidth = toInteger $ rect_width scr
screenHeight = toInteger $ rect_height scr
selectedElement <- if (status == grabSuccess) then do
selectedElement <- if status == grabSuccess then do
let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
restrictX = floor $ restriction screenWidth gs_cellwidth
restrictY = floor $ restriction screenHeight gs_cellheight
originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
coords = diamondRestrict restrictX restrictY originPosX originPosY
s = TwoDState { td_curpos = (head coords),
s = TwoDState { td_curpos = head coords,
td_availSlots = coords,
td_elements = elements,
td_gsconfig = gsconfig,
@ -673,7 +673,7 @@ gridselect gsconfig elements =
td_searchString = "",
td_elementmap = [] }
m <- generateElementmap s
evalTwoD (updateAllElements >> (gs_navigate gsconfig))
evalTwoD (updateAllElements >> gs_navigate gsconfig)
(s { td_elementmap = m })
else
return Nothing
@ -695,16 +695,13 @@ gridselectWindow gsconf = windowMap >>= gridselect gsconf
withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
withSelectedWindow callback conf = do
mbWindow <- gridselectWindow conf
case mbWindow of
Just w -> callback w
Nothing -> return ()
for_ mbWindow callback
windowMap :: X [(String,Window)]
windowMap = do
ws <- gets windowset
wins <- mapM keyValuePair (W.allWindows ws)
return wins
where keyValuePair w = flip (,) w <$> decorateName' w
mapM keyValuePair (W.allWindows ws)
where keyValuePair w = (, w) <$> decorateName' w
decorateName' :: Window -> X String
decorateName' w = do
@ -782,7 +779,7 @@ noRearranger _ = return
-- already present).
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
searchStringRearrangerGenerator f =
let r "" xs = return $ xs
r s xs | s `elem` map fst xs = return $ xs
let r "" xs = return xs
r s xs | s `elem` map fst xs = return xs
| otherwise = return $ xs ++ [(s, f s)]
in r

View File

@ -224,5 +224,5 @@ isOnAnyVisibleWS = do
ws <- liftX $ gets windowset
let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
visibleWs = w `elem` allVisible
unfocused = maybe True (w /=) $ SS.peek ws
unfocused = Just w /= SS.peek ws
return $ visibleWs && unfocused

View File

@ -33,7 +33,7 @@ import XMonad.Util.Paste
import qualified XMonad.Util.ExtensibleState as XS
data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
newtype KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
instance ExtensionClass KeymapTable where
initialValue = KeymapTable []
@ -124,8 +124,8 @@ extractKeyMapping (KeymapTable table) mask sym =
buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
buildKeyRemapBindings keyremaps =
[((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
bindings = nub (map (\binding -> fst binding) mappings)
where mappings = concatMap (\(KeymapTable table) -> table) keyremaps
bindings = nub (map fst mappings)
-- Here come the Keymappings
@ -137,7 +137,7 @@ emptyKeyRemap = KeymapTable []
dvorakProgrammerKeyRemap :: KeymapTable
dvorakProgrammerKeyRemap =
KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
(maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
(maskFrom, from, maskTo, to) <- zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey]
where
layoutUs = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?" :: [KeySym]

View File

@ -61,7 +61,7 @@ type ExtensionActions = M.Map String (String -> X())
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
completionFunction CalcMode = \s -> if null s then return [] else
lines <$> runProcessWithInput "calc" [s] ""
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard

View File

@ -27,6 +27,7 @@ module XMonad.Actions.LinkWorkspaces (
) where
import XMonad
import XMonad.Prelude (for_)
import qualified XMonad.StackSet as W
import XMonad.Layout.IndependentScreens(countScreens)
import qualified XMonad.Util.ExtensibleState as XS (get, put)
@ -59,7 +60,7 @@ import qualified Data.Map as M
-- For detailed instructions on editing your key bindings, see
-- "XMonad.Doc.Extending#Editing_key_bindings".
data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
, foreground :: [Char]
, alertedForeground :: [Char]
, background :: [Char]
@ -75,7 +76,7 @@ noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
noMessageFn _ _ _ _ = return () :: X ()
-- | Stuff for linking workspaces
data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
newtype WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
instance ExtensionClass WorkspaceMap
where initialValue = WorkspaceMap M.empty
extensionType = PersistentExtension
@ -85,12 +86,12 @@ switchWS f m ws = switchWS' f m ws Nothing
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
-- | we already did switching on
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X ()
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> Maybe ScreenId -> X ()
switchWS' switchFn message workspace stopAtScreen = do
ws <- gets windowset
nScreens <- countScreens
let now = W.screen (W.current ws)
let next = ((now + 1) `mod` nScreens)
let next = (now + 1) `mod` nScreens
switchFn workspace
case stopAtScreen of
Nothing -> sTM now next (Just now)
@ -99,11 +100,11 @@ switchWS' switchFn message workspace stopAtScreen = do
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
-> ScreenId -> (Maybe ScreenId) -> X ()
switchToMatching :: (WorkspaceId -> Maybe ScreenId -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
-> ScreenId -> Maybe ScreenId -> X ()
switchToMatching f message t now next stopAtScreen = do
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
case (M.lookup t matchings) of
case M.lookup t matchings of
Nothing -> return () :: X()
Just newWorkspace -> do
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
@ -113,7 +114,7 @@ switchToMatching f message t now next stopAtScreen = do
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
toggleMatching message t1 t2 = do
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
case (M.lookup t1 matchings) of
case M.lookup t1 matchings of
Nothing -> setMatching message t1 t2 matchings
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
return ()
@ -142,7 +143,7 @@ removeAllMatchings :: MessageConfig -> X ()
removeAllMatchings message = do
ws <- gets windowset
let now = W.screen (W.current ws)
XS.put $ WorkspaceMap $ M.empty
XS.put $ WorkspaceMap M.empty
messageFunction message now (alertedForeground message) (background message) "All links removed!"
-- | remove all matching regarding a given workspace
@ -163,7 +164,6 @@ toggleLinkWorkspaces' first message = do
let now = W.screen (W.current ws)
let next = (now + 1) `mod` nScreens
if next == first then return () else do -- this is also the case if there is only one screen
case (W.lookupWorkspace next ws) of
Nothing -> return ()
Just name -> toggleMatching message (W.currentTag ws) (name)
for_ (W.lookupWorkspace next ws)
(toggleMatching message (W.currentTag ws))
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next

View File

@ -106,7 +106,7 @@ import Control.Monad.State ( gets )
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB m = windowBracket id $ do
w <- workspace . current <$> gets windowset
w <- gets ((workspace . current) . windowset)
ml <- handleMessage (layout w) m `catchX` return Nothing
whenJust ml $ \l ->
modifyWindowSet $ \ws -> ws { current = (current ws)
@ -138,7 +138,7 @@ sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB m
= (gets $ workspace . current . windowset)
= gets (workspace . current . windowset)
>>= sendSomeMessageWithNoRefreshB m
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the

View File

@ -118,7 +118,7 @@ maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
-- | Perform an action with first minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withFirstMinimized :: (Window -> X ()) -> X ()
withFirstMinimized action = withFirstMinimized' (flip whenJust action)
withFirstMinimized action = withFirstMinimized' (`whenJust` action)
-- | Like withFirstMinimized but the provided action is always invoked with a
-- 'Maybe Window', that will be nothing if there is no first minimized window.
@ -128,7 +128,7 @@ withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
-- | Perform an action with last minimized window on current workspace
-- or do nothing if there is no minimized windows on current workspace
withLastMinimized :: (Window -> X ()) -> X ()
withLastMinimized action = withLastMinimized' (flip whenJust action)
withLastMinimized action = withLastMinimized' (`whenJust` action)
-- | Like withLastMinimized but the provided action is always invoked with a
-- 'Maybe Window', that will be nothing if there is no last minimized window.

View File

@ -110,7 +110,7 @@ mouseGestureH moveHook endHook = do
mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
mouseGesture tbl win = do
(mov, end) <- mkCollect
mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
mouseGestureH (void . mov) $ end >>= \gest ->
case M.lookup gest tbl of
Nothing -> return ()
Just f -> f win

View File

@ -1,4 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
-----------------------------------------------------------------------------
-- |
@ -56,7 +56,7 @@ import XMonad.Util.XUtils
mouseResize :: l a -> ModifiedLayout MouseResize l a
mouseResize = ModifiedLayout (MR [])
data MouseResize a = MR [((a,Rectangle),Maybe a)]
newtype MouseResize a = MR [((a,Rectangle),Maybe a)]
instance Show (MouseResize a) where show _ = ""
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
@ -68,7 +68,7 @@ instance LayoutModifier MouseResize Window where
where
wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs
initState = mapM createInputWindow wrs'
processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
processState = mapM_ (deleteInputWin . snd) st >> mapM createInputWindow wrs'
inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10

View File

@ -59,7 +59,7 @@ module XMonad.Actions.Navigation2D ( -- * Usage
import qualified Data.List as L
import qualified Data.Map as M
import Data.Ord (comparing)
import Control.Arrow (second)
import XMonad.Prelude
import XMonad hiding (Screen)
import qualified XMonad.StackSet as W
@ -476,7 +476,7 @@ switchLayer = actOnLayer otherLayer
-- 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
windowGo dir = actOnLayer thisLayer
( \ conf cur wins -> windows
$ doTiledNavigation conf dir W.focusWindow cur wins
)
@ -486,7 +486,6 @@ windowGo dir wrap = actOnLayer thisLayer
( \ 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
@ -495,7 +494,7 @@ windowGo dir wrap = actOnLayer thisLayer
-- 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
windowSwap dir = actOnLayer thisLayer
( \ conf cur wins -> windows
$ doTiledNavigation conf dir swap cur wins
)
@ -503,32 +502,28 @@ windowSwap dir wrap = actOnLayer thisLayer
$ 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
windowToScreen dir = 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
screenGo dir = 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
screenSwap dir = 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
@ -648,7 +643,7 @@ doFocusClosestWindow (cur, rect) winrects
where
ctr = centerOf rect
winctrs = filter ((cur /=) . fst)
$ map (\(w, r) -> (w, centerOf r)) winrects
$ map (second centerOf) winrects
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
| otherwise = wc1
@ -668,8 +663,7 @@ doTiledNavigation conf dir act cur winrects winset
nav = maximum
$ map ( fromMaybe (defaultTiledNavigation conf)
. flip L.lookup (layoutNavigation conf)
)
$ layouts
) layouts
-- | Implements navigation for the float layer
doFloatNavigation :: Navigation2DConfig
@ -714,7 +708,7 @@ doLineNavigation dir (cur, rect) winrects
-- The list of windows that are candidates to receive focus.
winrects' = filter dirFilter
$ filter ((cur /=) . fst)
. filter ((cur /=) . fst)
$ winrects
-- Decides whether a given window matches the criteria to be a candidate to
@ -755,9 +749,8 @@ doCenterNavigation dir (cur, rect) winrects
-- 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
winctrs = map (second (dirTransform . centerOf))
$ 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
@ -815,7 +808,7 @@ doSideNavigationWithBias ::
Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
doSideNavigationWithBias bias dir (cur, rect)
= fmap fst . listToMaybe
. L.sortBy (comparing dist) . foldr acClosest []
. L.sortOn dist . foldr acClosest []
. filter (`toRightOf` (cur, transform rect))
. map (fmap transform)
where
@ -843,7 +836,7 @@ doSideNavigationWithBias bias dir (cur, rect)
-- Greedily accumulate the windows tied for the leftmost left side.
acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
| x1 r > x1 r' = l
acClosest (w, r) _ = (w, r) : []
acClosest (w, r) _ = [(w, r)]
-- Given a (_, SideRect), calculate how far it is from the y=bias line.
dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
@ -864,7 +857,7 @@ swap win winset = W.focusWindow cur
visws = map W.workspace scrs
-- The focused windows of the visible workspaces
focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
focused = mapMaybe (fmap W.focus . W.stack) visws
-- The window lists of the visible workspaces
wins = map (W.integrate' . W.stack) visws
@ -891,8 +884,8 @@ centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r
-- | Functions to choose the subset of windows to operate on
thisLayer, otherLayer :: a -> a -> a
thisLayer = curry fst
otherLayer = curry snd
thisLayer = const
otherLayer _ x = x
-- | Returns the list of visible workspaces and their screen rects
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
@ -929,8 +922,8 @@ 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
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

View File

@ -30,7 +30,7 @@ module XMonad.Actions.PhysicalScreens (
) where
import XMonad
import XMonad.Prelude (findIndex, on, sortBy)
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
import qualified XMonad.StackSet as W
{- $usage
@ -70,7 +70,7 @@ For detailed instructions on editing your key bindings, see
-- | The type of the index of a screen by location
newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Rectangle)
getScreenIdAndRectangle screen = (W.screen screen, rect) where
rect = screenRect $ W.screenDetail screen
@ -129,7 +129,7 @@ getNeighbour :: ScreenComparator -> Int -> X ScreenId
getNeighbour (ScreenComparator cmpScreen) d =
do w <- gets windowset
let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
curPos = fromMaybe 0 $ elemIndex (W.screen (W.current w)) ss
pos = (curPos + d) `mod` length ss
return $ ss !! pos

View File

@ -140,7 +140,7 @@ usePrefixArgument prefix conf = conf {
useDefaultPrefixArgument :: LayoutClass l Window
=> XConfig l
-> XConfig l
useDefaultPrefixArgument = usePrefixArgument (\_ -> (controlMask, xK_u))
useDefaultPrefixArgument = usePrefixArgument (const (controlMask, xK_u))
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
handlePrefixArg events = do

View File

@ -40,8 +40,8 @@ import XMonad
-- | Rotate the windows in the current stack, excluding the first one
-- (master).
rotSlavesUp,rotSlavesDown :: X ()
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l]))
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l))
-- | The actual rotation, as a pure function on the window stack.
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
@ -49,12 +49,12 @@ rotSlaves' _ s@(Stack _ [] []) = s
rotSlaves' f (Stack t [] rs) = Stack t [] (f rs) -- Master has focus
rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise
where (master:ws) = integrate s
(revls',t':rs') = splitAt (length ls) (master:(f ws))
(revls',t':rs') = splitAt (length ls) (master:f ws)
-- | Rotate all the windows in the current stack.
rotAllUp,rotAllDown :: X ()
rotAllUp = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l]))
rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l))
-- | The actual rotation, as a pure function on the window stack.
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a

View File

@ -152,8 +152,7 @@ rotateSome p (Stack t ls rs) =
. span ((< 0) . fst)
. sortOn fst
. (++) anchors
. map (fst *** snd)
$ zip movables (rotate movables)
$ zipWith (curry (fst *** snd)) movables (rotate movables)
in
Stack t' (reverse ls') rs'

View File

@ -213,7 +213,7 @@ engine.
Happy searching! -}
-- | A customized prompt indicating we are searching, and the name of the site.
data Search = Search Name
newtype Search = Search Name
instance XPrompt Search where
showXPrompt (Search name)= "Search [" ++ name ++ "]: "
nextCompletion _ = getNextCompletion
@ -260,7 +260,7 @@ search browser site query = safeSpawn browser [site query]
Generally, examining the resultant URL of a search will allow you to reverse-engineer
it if you can't find the necessary URL already described in other projects such as Surfraw. -}
searchEngine :: Name -> String -> SearchEngine
searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
searchEngine name site = searchEngineF name (\s -> site ++ escape s)
{- | If your search engine is more complex than this (you may want to identify
the kind of input and make the search URL dependent on the input or put the query
@ -316,7 +316,7 @@ vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
multi :: SearchEngine
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google]
{- | This function wraps up a search engine and creates a new one, which works
like the argument, but goes directly to a URL if one is given rather than
@ -326,7 +326,7 @@ multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbt
Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
intelligent :: SearchEngine -> SearchEngine
intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
intelligent (SearchEngine name site) = searchEngineF name (\s -> if takeWhile (/= ':') s `elem` ["http", "https", "ftp"] then s else site s)
-- | > removeColonPrefix "foo://bar" ~> "//bar"
-- > removeColonPrefix "foo//bar" ~> "foo//bar"

View File

@ -87,8 +87,8 @@ 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)
when (mtyp == a && not (null d))
(whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
mempty
handleTimerEvent _ = mempty

View File

@ -124,7 +124,7 @@ manageSpawnWithGC garbageCollect = do
mkPrompt :: (String -> X ()) -> XPConfig -> X ()
mkPrompt cb c = do
cmds <- io $ getCommands
cmds <- io getCommands
mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
@ -145,13 +145,13 @@ spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
-- | Replacement for 'spawn' which launches
-- application on given workspace.
spawnOn :: WorkspaceId -> String -> X ()
spawnOn ws cmd = spawnAndDo (doShift ws) cmd
spawnOn ws = spawnAndDo (doShift ws)
-- | Spawn an application and apply the manage hook when it opens.
spawnAndDo :: ManageHook -> String -> X ()
spawnAndDo mh cmd = do
p <- spawnPID $ mangle cmd
modifySpawner $ ((p,mh) :)
modifySpawner ((p,mh) :)
where
-- TODO this is silly, search for a better solution
mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs

View File

@ -338,7 +338,7 @@ split' p i l =
then (c+1,e:ys,ns)
else (c+1,ys,e:ns)
(c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
in (c',ys',snd . unzip $ ns')
in (c',ys',map snd ns')
-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
-- unindexed list with elements from the leftover indexed list appended.

View File

@ -59,6 +59,7 @@ swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurr
-- one with the two corresponding workspaces' tags swapped.
swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
swapWorkspaces t1 t2 = mapWorkspace swap
where swap w = if tag w == t1 then w { tag = t2 }
else if tag w == t2 then w { tag = t1 }
else w
where swap w
| tag w == t1 = w { tag = t2 }
| tag w == t2 = w { tag = t1 }
| otherwise = w

View File

@ -82,8 +82,7 @@ getTags w = withDisplay $ \d ->
io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
getTextProperty d w >>=
wcTextPropertyToTextList d)
(econst [[]])
>>= return . words . unwords
(econst [[]]) <&> (words . unwords)
-- | check a window for the given tag
hasTag :: String -> Window -> X Bool
@ -93,7 +92,7 @@ hasTag s w = (s `elem`) <$> getTags w
addTag :: String -> Window -> X ()
addTag s w = do
tags <- getTags w
if (s `notElem` tags) then setTags (s:tags) w else return ()
when (s `notElem` tags) $ setTags (s:tags) w
-- | remove a tag from a window, if it exists
delTag :: String -> Window -> X ()
@ -156,7 +155,7 @@ withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
withTaggedGlobal' t m = gets windowset >>=
filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
filterM (hasTag t) . concatMap (integrate' . stack) . workspaces >>= m
withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
withFocusedP f = withFocused $ windows . f
@ -165,7 +164,7 @@ shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s
shiftHere w s = shiftWin (currentTag s) w s
shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
shiftToScreen sid w s = case filter (\m -> sid /= screen m) (current s:visible s) of
[] -> s
(t:_) -> shiftWin (tag . workspace $ t) w s
@ -181,17 +180,16 @@ tagPrompt c f = do
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
tagComplList :: X [String]
tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
mapM getTags >>=
return . nub . concat
tagComplList = gets (concatMap (integrate' . stack) . workspaces . windowset)
>>= mapM getTags
<&> nub . concat
tagDelPrompt :: XPConfig -> X ()
tagDelPrompt c = do
sc <- tagDelComplList
if (sc /= [])
then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s))
else return ()
when (sc /= []) $
mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (withFocused . delTag)
tagDelComplList :: X [String]
tagDelComplList = gets windowset >>= maybe (return []) getTags . peek

View File

@ -2,6 +2,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.TreeSelect
@ -65,7 +66,7 @@ module XMonad.Actions.TreeSelect
import Control.Monad.Reader
import Control.Monad.State
import Data.Tree
import Foreign
import Foreign (shiftL, shiftR, (.&.))
import System.IO
import System.Posix.Process (forkProcess, executeFile)
import XMonad hiding (liftX)
@ -451,8 +452,8 @@ splitPath i = case break (== '.') i of
-- > ]
-- > ]
treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
treeselectAction c xs = treeselect c xs >>= \x -> case x of
Just a -> a >> return ()
treeselectAction c xs = treeselect c xs >>= \case
Just a -> void a
Nothing -> return ()
forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
@ -464,7 +465,7 @@ mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs
-- | Quit returning the currently selected node
select :: TreeSelect a (Maybe a)
select = Just <$> gets (tsn_value . cursor . tss_tree)
select = gets (Just . (tsn_value . cursor . tss_tree))
-- | Quit without returning anything
cancel :: TreeSelect a (Maybe a)

View File

@ -39,7 +39,7 @@ import qualified XMonad.StackSet as W
-- | Changes the focus if the mouse is moved within an unfocused window.
focusOnMouseMove :: Event -> X All
focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
focusOnMouseMove MotionEvent{ ev_x = x, ev_y = y, ev_window = root } = do
-- check only every 15 px to avoid excessive calls to translateCoordinates
when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
dpy <- asks display

View File

@ -104,5 +104,7 @@ lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
clip :: Ord a => (a, a) -> a -> a
clip (lower, upper) x = if x < lower then lower
else if x > upper then upper else x
clip (lower, upper) x
| x < lower = lower
| x > upper = upper
| otherwise = x

View File

@ -101,7 +101,7 @@ warpToWindow h v =
warpToScreen :: ScreenId -> Rational -> Rational -> X ()
warpToScreen n h v = do
root <- asks theRoot
(StackSet {current = x, visible = xs}) <- gets windowset
StackSet{current = x, visible = xs} <- gets windowset
whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
$ \r ->
warp root (rect_x r + fraction h (rect_width r))

View File

@ -146,7 +146,7 @@ windowMap' titler = do
ws <- gets X.windowset
M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
keyValuePair ws w = flip (,) w <$> titler ws w
keyValuePair ws w = (, w) <$> titler ws w
-- | Returns the window name as will be listed in dmenu.
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user

View File

@ -68,7 +68,7 @@ windowMenu = withFocused $ \w -> do
| tag <- tags ]
runSelectedAction gsConfig actions
getSize :: Window -> X (Rectangle)
getSize :: Window -> X Rectangle
getSize w = do
d <- asks display
wa <- io $ getWindowAttributes d w

View File

@ -40,7 +40,7 @@ module XMonad.Actions.WindowNavigation (
) where
import XMonad
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortBy)
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
import XMonad.Util.Types (Direction2D(..))
import qualified XMonad.StackSet as W
@ -48,7 +48,6 @@ import Control.Arrow (second)
import Data.IORef
import Data.Map (Map())
import qualified Data.Map as M
import Data.Ord (comparing)
import qualified Data.Set as S
-- $usage
@ -123,9 +122,12 @@ swap = withTargetWindow swapWithFocused
mapWindows (swapWin currentWin targetWin) winSet
Nothing -> winSet
mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
mapWindows' f ws@W.Workspace{ W.stack = s } = ws { W.stack = mapWindows'' f <$> s }
mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
swapWin win1 win2 win
| win == win1 = win2
| win == win2 = win1
| otherwise = win
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
@ -191,7 +193,7 @@ windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect win = withDisplay $ \dpy -> do
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
return $ Just $ (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
`catchX` return Nothing
-- Modified from droundy's implementation of WindowNavigation:
@ -207,7 +209,7 @@ inr L (Point px py) (Rectangle rx ry w h) = px > rx + fromIntegral w
py >= ry && py < ry + fromIntegral h
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby D = sortBy $ comparing (rect_y . snd)
sortby R = sortBy $ comparing (rect_x . snd)
sortby D = sortOn (rect_y . snd)
sortby R = sortOn (rect_x . snd)
sortby U = reverse . sortby D
sortby L = reverse . sortby R

View File

@ -67,14 +67,14 @@ instance ExtensionClass WorkscreenStorage where
-- | Helper to group workspaces. Multiply workspace by screens number.
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
expandWorkspace nscr ws = concat $ map expandId ws
expandWorkspace nscr = concatMap expandId
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 n ws = zipWith Workscreen [0..] (fromWorkspace' n ws)
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
fromWorkspace' _ [] = []
fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)

View File

@ -49,10 +49,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
fromMessage, sendMessage, windows, gets)
import XMonad.Util.Stack (reverseS)
import Control.Applicative (liftA2)
import Control.Monad((<=<), guard, when)
import Data.Foldable(toList)
import Data.Maybe(fromJust, listToMaybe)
import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
-- $usage
--
@ -143,7 +140,7 @@ getFocus (End x) = x
-- This could be made more efficient, if the fact that the suffixes are grouped
focusTo :: (Eq t) => t -> Cursors t -> Maybe (Cursors t)
focusTo x = listToMaybe . filter ((x==) . getFocus) . changeFocus (const True)
focusTo x = find ((x==) . getFocus) . changeFocus (const True)
-- | non-wrapping version of 'W.focusUp''
noWrapUp :: W.Stack t -> W.Stack t
@ -192,7 +189,7 @@ modifyLayer' f depth = modifyCursors (descend f depth)
modifyCursors :: (Cursors String -> X (Cursors String)) -> X ()
modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
data WorkspaceCursors a = WorkspaceCursors (Cursors String)
newtype WorkspaceCursors a = WorkspaceCursors (Cursors String)
deriving (Typeable,Read,Show)
-- | The state is stored in the 'WorkspaceCursors' layout modifier. Put this as
@ -201,7 +198,7 @@ data WorkspaceCursors a = WorkspaceCursors (Cursors String)
workspaceCursors :: Cursors String -> l a -> ModifiedLayout WorkspaceCursors l a
workspaceCursors = ModifiedLayout . WorkspaceCursors
data ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
newtype ChangeCursors = ChangeCursors { unWrap :: Cursors String -> X (Cursors String) }
deriving (Typeable)
instance Message ChangeCursors

View File

@ -161,7 +161,7 @@ swapNames w1 w2 = do
WorkspaceNames m <- XS.get
let getname w = fromMaybe "" $ M.lookup w m
set w name m' = if null name then M.delete w m' else M.insert w name m'
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) m
-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
workspaceNamePrompt :: XPConfig -> (WorkspaceId -> X ()) -> X ()

View File

@ -46,7 +46,7 @@ azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
azertyKeysTop topRow conf@XConfig{modMask = modm} = M.fromList $
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
++
[((m .|. modm, k), windows $ f i)

View File

@ -39,9 +39,8 @@ import qualified Data.Map as M
bepoConfig = def { keys = bepoKeys <+> keys def }
bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
++
[((m .|. modm, k), windows $ f i)
bepoKeys conf@XConfig { modMask = modm } = M.fromList $
((modm, xK_semicolon), sendMessage (IncMasterN (-1)))
: [((m .|. modm, k), windows $ f i)
| (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]

View File

@ -80,7 +80,7 @@ bluetileWorkspaces :: [String]
bluetileWorkspaces = ["1","2","3","4","5","6","7","8","9","0"]
bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
bluetileKeys conf@XConfig{XMonad.modMask = modMask'} = M.fromList $
-- launching and killing programs
[ ((modMask' , xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
, ((modMask', xK_p ), gnomeRun) -- %! Launch Gnome "Run application" dialog
@ -111,14 +111,14 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
-- floating layer support
, ((modMask', xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
, ((modMask' .|. shiftMask, xK_t ), withFocused $ float ) -- %! Float window
, ((modMask' .|. shiftMask, xK_t ), withFocused float ) -- %! Float window
-- increase or decrease number of windows in the master area
, ((modMask' , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
, ((modMask' , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- quit, or restart
, ((modMask' .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit
, ((modMask' .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit
, ((modMask' , xK_q ), restart "xmonad" True) -- %! Restart
-- Metacity-like workspace switching
@ -158,19 +158,19 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
bluetileMouseBindings (XConfig {XMonad.modMask = modMask'}) = M.fromList $
bluetileMouseBindings XConfig{XMonad.modMask = modMask'} = M.fromList
-- mod-button1 %! Move a floated window by dragging
[ ((modMask', button1), (\w -> isFloating w >>= \isF -> when (isF) $
focus w >> mouseMoveWindow w >> windows W.shiftMaster))
[ ((modMask', button1), \w -> isFloating w >>= \isF -> when isF $
focus w >> mouseMoveWindow w >> windows W.shiftMaster)
-- mod-button2 %! Switch to next and first layout
, ((modMask', button2), (\_ -> sendMessage NextLayout))
, ((modMask' .|. shiftMask, button2), (\_ -> sendMessage $ JumpToLayout "Floating"))
, ((modMask', button2), \_ -> sendMessage NextLayout)
, ((modMask' .|. shiftMask, button2), \_ -> sendMessage $ JumpToLayout "Floating")
-- mod-button3 %! Resize a floated window by dragging
, ((modMask', button3), (\w -> isFloating w >>= \isF -> when (isF) $
focus w >> mouseResizeWindow w >> windows W.shiftMaster))
, ((modMask', button3), \w -> isFloating w >>= \isF -> when isF $
focus w >> mouseResizeWindow w >> windows W.shiftMaster)
]
isFloating :: Window -> X (Bool)
isFloating :: Window -> X Bool
isFloating w = do
ws <- gets windowset
return $ M.member w (W.floating ws)
@ -181,16 +181,15 @@ bluetileManageHook = composeAll
, className =? "MPlayer" --> doFloat
, isFullscreen --> doFullFloat]
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $
named "Floating" floating |||
named "Tiled1" tiled1 |||
named "Tiled2" tiled2 |||
named "Fullscreen" fullscreen
)
where
floating = floatingDeco $ maximize $ borderResize $ positionStoreFloat
tiled1 = tilingDeco $ maximize $ mouseResizableTileMirrored
tiled2 = tilingDeco $ maximize $ mouseResizableTile
floating = floatingDeco $ maximize $ borderResize positionStoreFloat
tiled1 = tilingDeco $ maximize mouseResizableTileMirrored
tiled2 = tilingDeco $ maximize mouseResizableTile
fullscreen = tilingDeco $ maximize $ smartBorders Full
tilingDeco l = windowSwitcherDecorationWithButtons shrinkText defaultThemeWithButtons (draggingVisualizer l)

View File

@ -171,10 +171,10 @@ desktopConfig = docks $ ewmh def
, logHook = desktopLogHook <+> logHook def
, keys = desktopKeys <+> keys def }
desktopKeys (XConfig {modMask = modm}) = M.fromList $
desktopKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_b), sendMessage ToggleStruts) ]
desktopLayoutModifiers layout = avoidStruts layout
desktopLayoutModifiers = avoidStruts
-- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to
-- activated window.

View File

@ -232,7 +232,7 @@ keyBindings conf = let m = modMask conf in fromList . anyMask $ [
((m .|. shiftMask , xK_p ), spawnHere termLauncher),
((m .|. shiftMask , xK_c ), kill),
((m , xK_q ), restart "xmonad" True),
((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)),
((m .|. shiftMask , xK_q ), io exitSuccess),
((m , xK_grave ), sendMessage NextLayout),
((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
((m , xK_o ), sendMessage Toggle),

View File

@ -14,7 +14,7 @@ import qualified XMonad (keys)
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
import System.Exit ( exitSuccess )
import XMonad.Layout.Tabbed ( tabbed,
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
@ -77,7 +77,7 @@ keys x = M.fromList $
, ((modMask x, xK_t ), withFocused $ windows . W.sink) -- %! Push window back into tiling
-- quit, or restart
, ((modMask x .|. shiftMask, xK_Escape), io (exitWith ExitSuccess)) -- %! Quit xmonad
, ((modMask x .|. shiftMask, xK_Escape), io exitSuccess) -- %! Quit xmonad
, ((modMask x , xK_Escape), restart "xmonad" True) -- %! Restart xmonad
, ((modMask x .|. shiftMask, xK_Right), moveTo Next HiddenNonEmptyWS)

View File

@ -29,7 +29,7 @@ main = do
xmonad $ desktopConfig
{ modMask = mod4Mask -- Use the "Win" key for the mod key
, manageHook = myManageHook <+> manageHook desktopConfig
, layoutHook = desktopLayoutModifiers $ myLayouts
, layoutHook = desktopLayoutModifiers myLayouts
, logHook = (dynamicLogString def >>= xmonadPropLog)
<+> logHook desktopConfig
}

View File

@ -45,7 +45,7 @@ gnomeConfig = desktopConfig
, keys = gnomeKeys <+> keys desktopConfig
, startupHook = gnomeRegister >> startupHook desktopConfig }
gnomeKeys (XConfig {modMask = modm}) = M.fromList $
gnomeKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), gnomeRun)
, ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]

View File

@ -47,12 +47,12 @@ kde4Config = desktopConfig
{ terminal = "konsole"
, keys = kde4Keys <+> keys desktopConfig }
kdeKeys (XConfig {modMask = modm}) = M.fromList $
kdeKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), spawn "dcop kdesktop default popupExecuteCommand")
, ((modm .|. shiftMask, xK_q), spawn "dcop kdesktop default logout")
]
kde4Keys (XConfig {modMask = modm}) = M.fromList $
kde4Keys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), spawn "krunner")
, ((modm .|. shiftMask, xK_q), spawn "dbus-send --print-reply --dest=org.kde.ksmserver /KSMServer org.kde.KSMServerInterface.logout int32:1 int32:0 int32:1")
]

View File

@ -39,7 +39,7 @@ lxqtConfig = desktopConfig
{ terminal = "qterminal"
, keys = lxqtKeys <+> keys desktopConfig }
lxqtKeys (XConfig {modMask = modm}) = M.fromList $
lxqtKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), spawn "lxqt-runner")
, ((modm .|. shiftMask, xK_q), spawn "lxqt-leave")
]

View File

@ -52,7 +52,7 @@ mateConfig = desktopConfig
, keys = mateKeys <+> keys desktopConfig
, startupHook = mateRegister >> startupHook desktopConfig }
mateKeys (XConfig {modMask = modm}) = M.fromList $
mateKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), mateRun)
, ((modm, xK_d), unGrab >> matePanel "MAIN_MENU")
, ((modm .|. shiftMask, xK_q), mateLogout) ]

View File

@ -45,5 +45,5 @@ add r x = tell (mkW (r ^: mappend x))
--
example :: Config ()
example = do
add layout $ LL [Layout $ Full] -- make this better
add layout $ LL [Layout Full] -- make this better
set terminal "urxvt"

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
-----------------------------------------------------------------------------
-- |
@ -478,7 +478,7 @@ wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++)
-- > wsSetName 1 "mail"
-- > wsSetName 2 "web"
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
wsSetName index newName = wsNames =. (map maybeSet . zip [0..])
wsSetName index newName = wsNames =. zipWith (curry maybeSet) [0..]
where maybeSet (i, oldName) | i == (index - 1) = newName
| otherwise = oldName
@ -497,8 +497,8 @@ withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
where sprime :: ScreenConfig -> Prime l l
sprime sconf =
(keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
(mod, action) <- sActions_ sconf])
keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
(mod, action) <- sActions_ sconf]
data ScreenConfig = ScreenConfig {
sKeys_ :: [String],

View File

@ -58,7 +58,7 @@ myStartupHook = do
spawnOnOnce "emacs" "emacs"
spawnNOnOnce 4 "xterms" "xterm"
myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
myLayoutHook = smartBorders $ avoidStruts standardLayouts
where standardLayouts = tiled ||| mosaic 2 [3,2] ||| Mirror tiled ||| Full
tiled = ResizableTall nmaster delta ratio []
nmaster = 1
@ -68,7 +68,7 @@ myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
myLogHook p = do
copies <- wsContainingCopies
let check ws | ws == "NSP" = "" -- Hide the scratchpad workspace
| ws `elem` copies = xmobarColor "red" "black" $ ws -- Workspaces with copied windows are red on black
| ws `elem` copies = xmobarColor "red" "black" ws -- Workspaces with copied windows are red on black
| otherwise = ws
dynamicLogWithPP $ xmobarPP { ppHidden = check
, ppOutput = hPutStrLn p

View File

@ -24,10 +24,10 @@ sjanssenConfig =
docks $ ewmh $ def
{ terminal = "exec urxvt"
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
, mouseBindings = \XConfig {modMask = modm} -> M.fromList
[ ((modm, button1), \w -> focus w >> mouseMoveWindow w)
, ((modm, button2), \w -> focus w >> windows W.swapMaster)
, ((modm.|. shiftMask, button1), \w -> focus w >> mouseResizeWindow w) ]
, keys = \c -> mykeys c `M.union` keys def c
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
, layoutHook = modifiers layouts
@ -50,12 +50,12 @@ sjanssenConfig =
, "trayer --transparent true --expand true --align right "
++ "--edge bottom --widthtype request" ]
mykeys (XConfig {modMask = modm}) = M.fromList $
mykeys XConfig{modMask = modm} = M.fromList
[((modm, xK_p ), shellPromptHere myPromptConfig)
,((modm .|. shiftMask, xK_Return), spawnHere =<< asks (terminal . config))
,((modm .|. shiftMask, xK_c ), kill1)
,((modm .|. shiftMask .|. controlMask, xK_c ), kill)
,((modm .|. shiftMask, xK_0 ), windows $ copyToAll)
,((modm .|. shiftMask, xK_0 ), windows copyToAll)
,((modm, xK_z ), layoutScreens 2 $ TwoPane 0.5 0.5)
,((modm .|. shiftMask, xK_z ), rescreen)
, ((modm , xK_b ), sendMessage ToggleStruts)

View File

@ -39,7 +39,7 @@ xfceConfig = desktopConfig
{ terminal = "xfce4-terminal"
, keys = xfceKeys <+> keys desktopConfig }
xfceKeys (XConfig {modMask = modm}) = M.fromList $
xfceKeys XConfig{modMask = modm} = M.fromList
[ ((modm, xK_p), spawn "xfrun4")
, ((modm .|. shiftMask, xK_p), spawn "xfce4-appfinder")
, ((modm .|. shiftMask, xK_q), spawn "xfce4-session-logout")

View File

@ -25,7 +25,7 @@ module XMonad.Hooks.CurrentWorkspaceOnTop (
import XMonad
import qualified XMonad.StackSet as S
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude(when)
import XMonad.Prelude (unless, when)
import qualified Data.Map as M
-- $usage
@ -40,7 +40,7 @@ import qualified Data.Map as M
-- > }
--
data CWOTState = CWOTS String deriving Typeable
newtype CWOTState = CWOTS String deriving Typeable
instance ExtensionClass CWOTState where
initialValue = CWOTS ""
@ -55,15 +55,15 @@ currentWorkspaceOnTop = withDisplay $ \d -> do
let s = S.current ws
wsp = S.workspace s
viewrect = screenRect $ S.screenDetail s
tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)
tmpStack = S.stack wsp >>= S.filter (`M.notMember` S.floating ws)
(rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
updateLayout curTag ml'
let this = S.view curTag ws
fltWins = filter (flip M.member (S.floating ws)) $ S.index this
wins = fltWins ++ (map fst rs) -- order: first all floating windows, then the order the layout returned
fltWins = filter (`M.member` S.floating ws) $ S.index this
wins = fltWins ++ map fst rs -- order: first all floating windows, then the order the layout returned
-- end of reimplementation
when (not . null $ wins) $ do
unless (null wins) $ do
io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top,
io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow
XS.put(CWOTS curTag)

View File

@ -51,7 +51,7 @@ 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
debugEventsHook' ConfigureRequestEvent{ev_window = w
,ev_parent = p
,ev_x = x
,ev_y = y
@ -61,7 +61,7 @@ debugEventsHook' (ConfigureRequestEvent {ev_window = w
,ev_above = above
,ev_detail = place
,ev_value_mask = msk
}) = do
} = do
windowEvent "ConfigureRequest" w
windowEvent " parent" p
-- mask <- quickFormat msk $ dumpBits wmCRMask
@ -84,45 +84,45 @@ debugEventsHook' (ConfigureRequestEvent {ev_window = w
]
say " requested" s
debugEventsHook' (ConfigureEvent {ev_window = w
debugEventsHook' ConfigureEvent {ev_window = w
,ev_above = above
}) = do
} = do
windowEvent "Configure" w
-- most of the content is covered by debugWindow
when (above /= none) $ debugWindow above >>= say " above"
debugEventsHook' (MapRequestEvent {ev_window = w
debugEventsHook' MapRequestEvent {ev_window = w
,ev_parent = p
}) =
} =
windowEvent "MapRequest" w >>
windowEvent " parent" p
debugEventsHook' e@(KeyEvent {ev_event_type = t})
debugEventsHook' e@KeyEvent {ev_event_type = t}
| t == keyPress =
io (hPutStr stderr "KeyPress ") >>
debugKeyEvents e >>
return ()
debugEventsHook' (ButtonEvent {ev_window = w
debugEventsHook' ButtonEvent {ev_window = w
,ev_state = s
,ev_button = b
}) = do
} = 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
}) =
debugEventsHook' DestroyWindowEvent {ev_window = w
} =
windowEvent "DestroyWindow" w
debugEventsHook' (UnmapEvent {ev_window = w
}) =
debugEventsHook' UnmapEvent {ev_window = w
} =
windowEvent "Unmap" w
debugEventsHook' (MapNotifyEvent {ev_window = w
}) =
debugEventsHook' MapNotifyEvent {ev_window = w
} =
windowEvent "MapNotify" w
{- way too much output; suppressed.
@ -133,26 +133,24 @@ debugEventsHook' (CrossingEvent {ev_window = w
windowEvent "Crossing" w >>
windowEvent " subwindow" s
-}
debugEventsHook' (CrossingEvent {}) =
debugEventsHook' CrossingEvent {} =
return ()
debugEventsHook' (SelectionRequest {ev_requestor = rw
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
debugEventsHook' PropertyEvent {ev_window = w
,ev_atom = a
,ev_propstate = s
}) = do
} = 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
if a' == "_NET_WM_USER_TIME" then return () else do
windowEvent "Property on" w
s' <- case s of
1 -> return "deleted"
@ -160,11 +158,11 @@ debugEventsHook' (PropertyEvent {ev_window = w
_ -> error "Illegal propState; Xlib corrupted?"
say " atom" $ a' ++ s'
debugEventsHook' (ExposeEvent {ev_window = w
}) =
debugEventsHook' ExposeEvent {ev_window = w
} =
windowEvent "Expose" w
debugEventsHook' (ClientMessageEvent {ev_window = w
debugEventsHook' ClientMessageEvent {ev_window = w
,ev_message_type = a
-- @@@ they did it again! no ev_format,
-- and ev_data is [CInt]
@ -172,7 +170,7 @@ debugEventsHook' (ClientMessageEvent {ev_window = w
-- that is setClientMessageEvent!
-- ,ev_format = b
,ev_data = vs'
}) = do
} = do
windowEvent "ClientMessage on" w
n <- atomName a
-- this is a sort of custom property
@ -219,12 +217,6 @@ clientMessages = [("_NET_ACTIVE_WINDOW",("_NET_ACTIVE_WINDOW",32,1))
,("WM_SAVE_YOURSELF" ,("STRING" , 8,0))
]
#if __GLASGOW_HASKELL__ < 707
finiteBitSize :: Bits a => a -> Int
finiteBitSize x = bitSize x
#endif
-- | Convert a modifier mask into a useful string
vmask :: KeyMask -> KeyMask -> String
vmask numLockMask msk = unwords $
@ -604,7 +596,7 @@ dumpArray item = do
dumpArray' :: Decoder Bool -> String -> Decoder Bool
dumpArray' item pfx = do
vs <- gets value
if vs == []
if null vs
then append "]"
else append pfx >> whenD item (dumpArray' item ",")
@ -713,7 +705,7 @@ dumpString = do
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
| otherwise -> inX (atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection
@ -744,7 +736,7 @@ dumpXKlInds = guardType iNTEGER $ do
| n .&. bt /= 0 = dumpInds (n .&. complement bt)
(bt `shiftL` 1)
(c + 1)
((show c):bs)
(show c:bs)
| otherwise = dumpInds n
(bt `shiftL` 1)
(c + 1)
@ -1189,7 +1181,7 @@ inhale b = error $ "inhale " ++ show b
eat :: Int -> Decoder Raw
eat n = do
(bs,rest) <- splitAt n <$> gets value
(bs,rest) <- gets (splitAt n . value)
modify (\r -> r {value = rest})
return bs

View File

@ -56,13 +56,13 @@ import System.IO (hPutStrLn
-- | Print key events to stderr for debugging
debugKeyEvents :: Event -> X All
debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
debugKeyEvents KeyEvent{ev_event_type = t, ev_state = m, ev_keycode = code}
| t == keyPress =
withDisplay $ \dpy -> do
sym <- io $ keycodeToKeysym dpy code 0
msk <- cleanMask m
nl <- gets numberlockMask
io $ hPutStrLn stderr $ intercalate " " ["keycode"
io $ hPutStrLn stderr $ unwords ["keycode"
,show code
,"sym"
,show sym
@ -86,7 +86,7 @@ hex v = "0x" ++ showHex v ""
-- | Convert a modifier mask into a useful string
vmask :: KeyMask -> KeyMask -> String
vmask numLockMask msk = intercalate " " $
vmask numLockMask msk = unwords $
reverse $
fst $
foldr vmask' ([],msk) masks

View File

@ -79,7 +79,7 @@ import qualified XMonad.Util.ExtensibleState as XS
-- is called when the number of screens changes and on startup.
--
data DynStatusBarInfo = DynStatusBarInfo
newtype DynStatusBarInfo = DynStatusBarInfo
{ dsbInfo :: [(ScreenId, Handle)]
} deriving (Typeable)
@ -113,12 +113,12 @@ dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup ->
dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)
dynStatusBarRun :: X () -> Event -> X All
dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)
dynStatusBarRun action RRScreenChangeNotifyEvent{} = action >> return (All True)
dynStatusBarRun _ _ = return (All True)
updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
updateStatusBars sb cleanup = do
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
(dsbInfoScreens, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo
screens <- getScreens
when (screens /= dsbInfoScreens) $ do
newHandles <- liftIO $ do
@ -129,14 +129,14 @@ updateStatusBars sb cleanup = do
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
updateStatusBars' sb cleanup = do
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
(dsbInfoScreens, dsbInfoHandles) <- XS.get <&> (unzip . dsbInfo)
screens <- getScreens
when (screens /= dsbInfoScreens) $ do
let oldInfo = zip dsbInfoScreens dsbInfoHandles
let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
newInfo <- liftIO $ do
mapM_ hClose $ map snd infoToClose
mapM_ cleanup $ map fst infoToClose
mapM_ (hClose . snd) infoToClose
mapM_ (cleanup . fst) infoToClose
let newScreens = screens \\ dsbInfoScreens
newHandles <- mapM sb newScreens
return $ zip newScreens newHandles
@ -153,7 +153,7 @@ multiPP = multiPPFormat dynamicLogString
multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
multiPPFormat dynlStr focusPP unfocusPP = do
(_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
(_, dsbInfoHandles) <- XS.get <&> unzip . dsbInfo
multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()

View File

@ -59,16 +59,16 @@ instance ExtensionClass DynamicHooks where
-- doFloat and doIgnore are idempotent.
-- | Master 'ManageHook' that must be in your @xmonad.hs@ 'ManageHook'.
dynamicMasterHook :: ManageHook
dynamicMasterHook = (ask >>= \w -> liftX (do
dynamicMasterHook = ask >>= \w -> liftX $ do
dh <- XS.get
(Endo f) <- runQuery (permanent dh) w
ts <- mapM (\(q,a) -> runQuery q w >>= \x -> return (x,(q, a))) (transients dh)
let (ts',nts) = partition fst ts
gs <- mapM (flip runQuery w . snd . snd) ts'
let (Endo g) = maybe (Endo id) id $ listToMaybe gs
let (Endo g) = fromMaybe (Endo id) $ listToMaybe gs
XS.put $ dh { transients = map snd nts }
return $ Endo $ f . g
))
-- | Appends the given 'ManageHook' to the permanent dynamic 'ManageHook'.
addDynamicHook :: ManageHook -> X ()
addDynamicHook m = updateDynamicHook (<+> m)
@ -87,4 +87,4 @@ updateDynamicHook f = XS.modify $ \dh -> dh { permanent = f (permanent dh) }
-- > oneShotHook dynHooksRef (className =? "example) doFloat
--
oneShotHook :: Query Bool -> ManageHook -> X ()
oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):(transients dh) }
oneShotHook q a = XS.modify $ \dh -> dh { transients = (q,a):transients dh }

View File

@ -1,5 +1,4 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.DynamicIcons

View File

@ -178,7 +178,7 @@ ewmhDesktopsLogHookCustom t = withWindowSet $ \s -> do
-- Remap the current workspace to handle any renames that f might be doing.
let maybeCurrent' = W.tag <$> listToMaybe (t [W.workspace $ W.current s])
current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
current = flip elemIndex (map W.tag ws) =<< maybeCurrent'
whenChanged (CurrentDesktop $ fromMaybe 0 current) $
mapM_ setCurrentDesktop current
@ -392,7 +392,7 @@ addSupported props = withDisplay $ \dpy -> do
a <- getAtom "_NET_SUPPORTED"
newSupportedList <- mapM (fmap fromIntegral . getAtom) props
io $ do
supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy a r
supportedList <- join . maybeToList <$> getWindowProperty32 dpy a r
changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)
setFullscreenSupported :: X ()

View File

@ -91,7 +91,7 @@ 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
isUnfocused = ask >>= \w -> liftX . gets $ (Just w /=) . W.peek . windowset
-- | 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
@ -103,7 +103,7 @@ isUnfocusedOnCurrentWS = do
w <- ask
ws <- liftX $ gets windowset
let thisWS = w `elem` W.index ws
unfocused = maybe True (w /=) $ W.peek ws
unfocused = Just w /= W.peek ws
return $ thisWS && unfocused
-- | Fades out every window by the amount returned by the query.

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.FadeWindows
@ -220,7 +220,7 @@ fadeWindowsLogHook h = withWindowSet $ \s -> do
-- "XMonad.Layout.Full" or "XMonad.Layout.Tabbed". This hook may
-- also be useful with "XMonad.Hooks.FadeInactive".
fadeWindowsEventHook :: Event -> X All
fadeWindowsEventHook (MapNotifyEvent {}) =
fadeWindowsEventHook MapNotifyEvent{} =
-- we need to run the fadeWindowsLogHook. only one way...
asks config >>= logHook >> return (All True)
fadeWindowsEventHook _ = return (All True)

View File

@ -1,4 +1,3 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.FloatNext

View File

@ -441,7 +441,7 @@ focusedCur' m = asks currentWorkspace >>= \i -> focusedOn' i m
-- | Does new window appear at particular workspace?
newOn :: WorkspaceId -> FocusQuery Bool
newOn i = (i ==) <$> asks newWorkspace
newOn i = asks ((i ==) . newWorkspace)
-- | Does new window appear at current workspace?
newOnCur :: FocusQuery Bool
newOnCur = asks currentWorkspace >>= newOn

View File

@ -38,5 +38,5 @@ takeFocusX _w = return ()
takeTopFocus ::
X ()
takeTopFocus =
(withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"
withWindowSet (maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"

View File

@ -21,7 +21,7 @@ module XMonad.Hooks.InsertPosition (
) where
import XMonad(ManageHook, MonadReader(ask))
import XMonad.Prelude (Endo (Endo), find, fromMaybe)
import XMonad.Prelude (Endo (Endo), find)
import qualified XMonad.StackSet as W
-- $usage
@ -44,7 +44,7 @@ insertPosition :: Position -> Focus -> ManageHook
insertPosition pos foc = Endo . g <$> ask
where
g w = viewingWs w (updateFocus w . ins w . W.delete' w)
ins w = (\f ws -> fromMaybe id (W.focusWindow <$> W.peek ws) $ f ws) $
ins w = (\f ws -> maybe id W.focusWindow (W.peek ws) $ f ws) $
case pos of
Master -> W.insertUp w . W.focusMaster
End -> insertDown w . W.modify' focusLast'

View File

@ -36,7 +36,7 @@ import XMonad.Util.EZConfig
import qualified XMonad.Util.ExtensibleState as XS
-- persistent state for manageHook debugging to trigger logHook debugging
data ManageStackDebug = MSD (Bool,Bool) deriving Typeable
newtype ManageStackDebug = MSD (Bool,Bool) deriving Typeable
instance ExtensionClass ManageStackDebug where
initialValue = MSD (False,False)

View File

@ -1,5 +1,4 @@
{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ManageDocks
@ -152,30 +151,30 @@ checkDock = ask >>= \w -> liftX $ do
desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
case mbr of
Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)
Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs
_ -> return False
-- | Whenever a new dock appears, refresh the layout immediately to avoid the
-- new dock.
docksEventHook :: Event -> X All
docksEventHook (MapNotifyEvent { ev_window = w }) = do
docksEventHook MapNotifyEvent{ ev_window = w } = do
whenX (runQuery checkDock w <&&> (not <$> isClient w)) $
whenX (updateStrutCache w) refreshDocks
return (All True)
docksEventHook (PropertyEvent { ev_window = w
, ev_atom = a }) = do
docksEventHook PropertyEvent{ ev_window = w
, ev_atom = a } = do
nws <- getAtom "_NET_WM_STRUT"
nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
when (a == nws || a == nwsp) $
whenX (updateStrutCache w) refreshDocks
return (All True)
docksEventHook (DestroyWindowEvent {ev_window = w}) = do
docksEventHook DestroyWindowEvent{ ev_window = w } = do
whenX (deleteFromStrutCache w) refreshDocks
return (All True)
docksEventHook _ = return (All True)
docksStartupHook :: X ()
docksStartupHook = void $ getStrutCache
docksStartupHook = void getStrutCache
-- | Gets the STRUT config, if present, in xmonad gap order
getStrut :: Window -> X [Strut]
@ -222,7 +221,7 @@ avoidStrutsOn :: LayoutClass l a =>
-> ModifiedLayout AvoidStruts l a
avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss)
data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
newtype AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
-- | Message type which can be sent to an 'AvoidStruts' layout
-- modifier to alter its behavior.

View File

@ -85,9 +85,7 @@ composeOne = foldr try (return mempty)
where
try q z = do
x <- q
case x of
Just h -> return h
Nothing -> z
maybe z return x
infixr 0 -?>, -->>, -?>>
@ -119,7 +117,7 @@ p -?> f = do
(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
p -->> f = do
Match b m <- p
if b then (f m) else return mempty
if b then f m else return mempty
-- | A helper operator for use in 'composeOne'. It takes a condition and a function taking a groupdatum to action. If 'p' is true, it executes the resulting action. If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
@ -166,7 +164,7 @@ isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
--
-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm45623487788432>.
pid :: Query (Maybe ProcessID)
pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w >>= pure . \case
pid = ask >>= \w -> liftX $ getProp32s "_NET_WM_PID" w <&> \case
Just [x] -> Just (fromIntegral x)
_ -> Nothing
@ -196,7 +194,7 @@ transience' = maybeToDefinite transience
--
-- See <https://tronche.com/gui/x/icccm/sec-5.html>.
clientLeader :: Query (Maybe Window)
clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w >>= pure . \case
clientLeader = ask >>= \w -> liftX $ getProp32s "WM_CLIENT_LEADER" w <&> \case
Just [x] -> Just (fromIntegral x)
_ -> Nothing
@ -256,12 +254,14 @@ doSideFloat :: Side -> ManageHook
doSideFloat side = doFloatDep move
where
move (W.RationalRect _ _ w h) = W.RationalRect cx cy w h
where cx = if side `elem` [SC,C ,NC] then (1-w)/2
else if side `elem` [SW,CW,NW] then 0
else {- side `elem` [SE,CE,NE] -} 1-w
cy = if side `elem` [CE,C ,CW] then (1-h)/2
else if side `elem` [NE,NC,NW] then 0
else {- side `elem` [SE,SC,SW] -} 1-h
where cx
| side `elem` [SC,C ,NC] = (1-w)/2
| side `elem` [SW,CW,NW] = 0
| otherwise = {- side `elem` [SE,CE,NE] -} 1-w
cy
| side `elem` [CE,C ,CW] = (1-h)/2
| side `elem` [NE,NC,NW] = 0
| otherwise = {- side `elem` [SE,SC,SW] -} 1-h
-- | Floats a new window with its original size, but centered.
doCenterFloat :: ManageHook

View File

@ -35,9 +35,9 @@ import XMonad.Prelude
-- > , handleEventHook = myHandleEventHook }
minimizeEventHook :: Event -> X All
minimizeEventHook (ClientMessageEvent {ev_window = w,
minimizeEventHook ClientMessageEvent{ev_window = w,
ev_message_type = mt,
ev_data = dt}) = do
ev_data = dt} = do
a_aw <- getAtom "_NET_ACTIVE_WINDOW"
a_cs <- getAtom "WM_CHANGE_STATE"

View File

@ -162,16 +162,16 @@ placeFocused p = withFocused $ \window -> do
-- use X.A.FloatKeys if the window is floating, send
-- a WindowArranger message otherwise.
case elem window floats of
True -> keysMoveWindowTo (x', y') (0, 0) window
False -> sendMessage $ SetGeometry r'
if window `elem` floats
then keysMoveWindowTo (x', y') (0, 0) window
else sendMessage $ SetGeometry r'
-- | Hook to automatically place windows when they are created.
placeHook :: Placement -> ManageHook
placeHook p = do window <- ask
r <- Query $ lift $ getWindowRectangle window
allRs <- Query $ lift $ getAllRectangles
allRs <- Query $ lift getAllRectangles
pointer <- Query $ lift $ getPointer window
return $ Endo $ \theWS -> fromMaybe theWS $
@ -186,13 +186,13 @@ placeHook p = do window <- ask
-- workspace's screen.
let infos = filter ((window `elem`) . stackContents . S.stack . fst)
$ [screenInfo $ S.current theWS]
++ (map screenInfo $ S.visible theWS)
++ map screenInfo (S.visible theWS)
++ zip (S.hidden theWS) (repeat currentRect)
guard(not $ null infos)
let (workspace, screen) = head infos
rs = catMaybes $ map (flip M.lookup allRs)
rs = mapMaybe (`M.lookup` allRs)
$ organizeClients workspace window floats
r' = purePlaceWindow p screen rs pointer r
newRect = r2rr screen r'
@ -221,7 +221,7 @@ purePlaceWindow :: Placement -- ^ The placement strategy
-> Rectangle -- ^ The window to be placed
-> Rectangle
purePlaceWindow (Bounds (t,r,b,l) p') (Rectangle sx sy sw sh) rs p w
= let s' = (Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b))
= let s' = Rectangle (sx + fi l) (sy + fi t) (sw - l - r) (sh - t - b)
in checkBounds s' $ purePlaceWindow p' s' rs p w
purePlaceWindow (Fixed ratios) s _ _ w = placeRatio ratios s w
@ -275,7 +275,7 @@ stackContents :: Maybe (S.Stack w) -> [w]
stackContents = maybe [] S.integrate
screenInfo :: S.Screen i l a sid ScreenDetail -> (S.Workspace i l a, Rectangle)
screenInfo (S.Screen { S.workspace = ws, S.screenDetail = (SD s)}) = (ws, s)
screenInfo S.Screen{ S.workspace = ws, S.screenDetail = (SD s)} = (ws, s)
getWindowRectangle :: Window -> X Rectangle
getWindowRectangle window
@ -325,8 +325,7 @@ getNecessaryData :: Window
getNecessaryData window ws floats
= do r <- getWindowRectangle window
rs <- return (organizeClients ws window floats)
>>= mapM getWindowRectangle
rs <- mapM getWindowRectangle (organizeClients ws window floats)
pointer <- getPointer window

View File

@ -92,12 +92,12 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do
(Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
(fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
where
randomIntOffset :: X (Int)
randomIntOffset :: X Int
randomIntOffset = io $ randomRIO (42, 242)
positionStoreEventHook :: Event -> X All
positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
positionStoreEventHook DestroyWindowEvent{ev_window = w, ev_event_type = et} = do
when (et == destroyNotify) $
modifyPosStore (\ps -> posStoreRemove ps w)
modifyPosStore (`posStoreRemove` w)
return (All True)
positionStoreEventHook _ = return (All True)

View File

@ -281,8 +281,9 @@ getRecentsMap = XS.get >>= \(RecentsMap m) -> return m
-- | Perform an X action dependent on successful lookup of the RecentWins for
-- the specified workspace, or return a default value.
withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap
>>= maybe (return dflt) (\(Recent lw cw) -> f lw cw)
withRecentsIn tag dflt f = maybe (return dflt) (\(Recent lw cw) -> f lw cw)
. M.lookup tag
=<< getRecentsMap
-- | The above specialised to the current workspace and unit.
withRecents :: (Window -> Window -> X ()) -> X ()

View File

@ -1,4 +1,4 @@
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ScreenCorners
@ -63,13 +63,13 @@ addScreenCorner corner xF = do
(win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
Nothing -> flip (,) xF <$> createWindowAt corner
Nothing -> (, xF) <$> createWindowAt corner
XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
-- | Add a list of @(ScreenCorner, X ())@ tuples
addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
addScreenCorners = mapM_ (uncurry addScreenCorner)
--------------------------------------------------------------------------------

View File

@ -55,12 +55,12 @@ serverModeEventHook = serverModeEventHook' defaultCommands
-- | serverModeEventHook' additionally takes an action to generate the list of
-- commands.
serverModeEventHook' :: X [(String,X ())] -> Event -> X All
serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
serverModeEventHook' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)
where helper cmd = do cl <- cmdAction
case lookup cmd (zip (map show [1 :: Integer ..]) cl) of
Just (_,action) -> action
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl
listOfCommands cl = zipWith (++) (map show [1 :: Int ..]) (map ((++) " - " . fst) cl)
-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
@ -75,7 +75,7 @@ serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands
-- | Additionally takes an action to generate the list of commands
serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
serverModeEventHookCmd' cmdAction = serverModeEventHookF "XMONAD_COMMAND" (mapM_ helper . words)
where helper cmd = do cl <- cmdAction
fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
@ -87,7 +87,7 @@ serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (se
-- > xmonadctl -a XMONAD_PRINT "hello world"
--
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
serverModeEventHookF key func ClientMessageEvent {ev_message_type = mt, ev_data = dt} = do
d <- asks display
atm <- io $ internAtom d key False
when (mt == atm && dt /= []) $ do
@ -95,6 +95,6 @@ serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data
cmd <- io $ getAtomName d atom
case cmd of
Just command -> func command
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ show atom)
return (All True)
serverModeEventHookF _ _ _ = return (All True)

View File

@ -62,7 +62,7 @@ _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
{- The current state is kept here -}
data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
newtype HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
instance ExtensionClass HookState where
initialValue = HookState empty

View File

@ -1,5 +1,4 @@
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeSynonymInstances, PatternGuards, DeriveDataTypeable,
FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
@ -196,7 +195,7 @@ import Foreign.C.Types (CLong)
-- instead.
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
h -> XConfig l -> XConfig l
withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
withUrgencyHook hook = withUrgencyHookC hook urgencyConfig
-- | This lets you modify the defaults set in 'urgencyConfig'. An example:
--
@ -211,7 +210,7 @@ withUrgencyHookC hook urgConf conf = conf {
startupHook = cleanupStaleUrgents >> startupHook conf
}
data Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
newtype Urgents = Urgents { fromUrgents :: [Window] } deriving (Read,Show,Typeable)
onUrgents :: ([Window] -> [Window]) -> Urgents -> Urgents
onUrgents f = Urgents . f . fromUrgents
@ -283,7 +282,7 @@ withUrgents f = readUrgents >>= f
cleanupStaleUrgents :: X ()
cleanupStaleUrgents = withWindowSet $ \ws -> do
adjustUrgents (filter (`W.member` ws))
adjustReminders (filter $ ((`W.member` ws) . window))
adjustReminders (filter ((`W.member` ws) . window))
adjustUrgents :: ([Window] -> [Window]) -> X ()
adjustUrgents = XS.modify . onUrgents
@ -324,7 +323,7 @@ changeNetWMState dpy w f = do
-- | Add an atom to the _NET_WM_STATE property.
addNetWMState :: Display -> Window -> Atom -> X ()
addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)
addNetWMState dpy w atom = changeNetWMState dpy w (fromIntegral atom :)
-- | Remove an atom from the _NET_WM_STATE property.
removeNetWMState :: Display -> Window -> Atom -> X ()
@ -356,7 +355,7 @@ handleEvent wuh event =
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w
if testBit flags urgencyHintBit then markUrgent w else markNotUrgent w
-- Window destroyed
DestroyWindowEvent {ev_window = w} ->
markNotUrgent w
@ -380,7 +379,7 @@ handleEvent wuh event =
mapM_ handleReminder =<< readReminders
where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
markUrgent w = do
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
adjustUrgents (\ws -> if w `elem` ws then ws else w : ws)
callUrgencyHook wuh w
userCodeDef () =<< asks (logHook . config)
markNotUrgent w = do
@ -423,9 +422,9 @@ cleanupUrgents sw = clearUrgents' =<< suppressibleWindows sw
clearUrgents' :: [Window] -> X ()
clearUrgents' ws = do
a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
dpy <- withDisplay (\dpy -> return dpy)
dpy <- withDisplay return
mapM_ (\w -> removeNetWMState dpy w a_da) ws
adjustUrgents (\\ ws) >> adjustReminders (filter $ ((`notElem` ws) . window))
adjustUrgents (\\ ws) >> adjustReminders (filter ((`notElem` ws) . window))
suppressibleWindows :: SuppressWhen -> X [Window]
suppressibleWindows Visible = gets $ S.toList . mapped
@ -491,7 +490,7 @@ instance UrgencyHook FocusHook where
borderUrgencyHook :: String -> Window -> X ()
borderUrgencyHook = urgencyHook . BorderUrgencyHook
data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
newtype BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: String }
deriving (Read, Show)
instance UrgencyHook BorderUrgencyHook where

View File

@ -35,7 +35,6 @@ import System.FilePath ((</>))
import System.Random (randomRIO)
import qualified Data.Map as M
import Data.Ord (comparing)
-- $usage
-- This module requires imagemagick and feh to be installed, as these are utilized
@ -176,7 +175,7 @@ completeWPConf (WallpaperConf dir (WallpaperList ws)) = do
getVisibleWorkspaces :: X [WorkspaceId]
getVisibleWorkspaces = do
winset <- gets windowset
return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset
return $ map (S.tag . S.workspace) . sortOn S.screen $ S.current winset : S.visible winset
getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
getPicPathsAndWSRects wpconf = do
@ -185,7 +184,7 @@ getPicPathsAndWSRects wpconf = do
visws <- getVisibleWorkspaces
let visscr = S.current winset : S.visible winset
visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr
hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)
hasPicAndIsVisible (n, mp) = n `elem` visws && isJust mp
getRect tag = screenRect $ fromJust $ M.lookup tag visrects
foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
return foundpaths
@ -224,4 +223,4 @@ layerCommand (rect, path) = do
Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in
" \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"
++ " -geometry +" ++ (show $rect_x rect) ++ "+" ++ (show $rect_y rect) ++ " -composite "
++ " -geometry +" ++ show (rect_x rect) ++ "+" ++ show (rect_y rect) ++ " -composite "

View File

@ -56,7 +56,7 @@ import XMonad.Prelude (Endo (..), chr)
-- should work fine. Others might not work.
--
type XPropMatch = ([(Atom, [String] -> Bool)], (Window -> X (WindowSet -> WindowSet)))
type XPropMatch = ([(Atom, [String] -> Bool)], Window -> X (WindowSet -> WindowSet))
pmX :: (Window -> X ()) -> Window -> X (WindowSet -> WindowSet)
pmX f w = f w >> return id
@ -71,10 +71,10 @@ xPropManageHook tms = mconcat $ map propToHook tms
mkQuery (a, tf) = fmap tf (getQuery a)
mkHook func = ask >>= Query . lift . fmap Endo . func
getProp :: Display -> Window -> Atom -> X ([String])
getProp :: Display -> Window -> Atom -> X [String]
getProp d w p = do
prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
let filt q | q == wM_COMMAND = concat . map splitAtNull
let filt q | q == wM_COMMAND = concatMap splitAtNull
| otherwise = id
return (filt p prop)
@ -82,7 +82,7 @@ getQuery :: Atom -> Query [String]
getQuery p = ask >>= \w -> Query . lift $ withDisplay $ \d -> getProp d w p
splitAtNull :: String -> [String]
splitAtNull s = case dropWhile (== (chr 0)) s of
splitAtNull s = case dropWhile (== chr 0) s of
"" -> []
s' -> w : splitAtNull s''
where (w, s'') = break (== (chr 0)) s'
where (w, s'') = break (== chr 0) s'

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.AutoMaster
@ -20,11 +20,13 @@ module XMonad.Layout.AutoMaster (
-- $usage
autoMaster, AutoMaster
) where
import XMonad.Prelude
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import XMonad.Prelude
import qualified XMonad.StackSet as W
import Control.Arrow (first)
-- $usage
-- This module defines layout modifier named autoMaster. It separates
@ -57,7 +59,7 @@ autoMess :: AutoMaster a -> SomeMessage -> Maybe (AutoMaster a)
autoMess (AutoMaster k bias delta) m = msum [fmap resize (fromMessage m),
fmap incmastern (fromMessage m)]
where incmastern (IncMasterN d) = AutoMaster (max 1 (k+d)) bias delta
resize Expand = AutoMaster k (min ( 0.4) $ bias+delta) delta
resize Expand = AutoMaster k (min 0.4 $ bias+delta) delta
resize Shrink = AutoMaster k (max (-0.4) $ bias-delta) delta
-- | Main layout function
@ -74,32 +76,32 @@ autoLayout k bias wksp rect = do
if null ws then
runLayout wksp rect
else
if (n<=k) then
return ((divideRow rect ws),Nothing)
if n<=k then
return (divideRow rect ws,Nothing)
else do
let master = take k ws
let filtStack = stack >>= W.filter (\w -> not (w `elem` master))
let filtStack = stack >>= W.filter (`notElem` master)
wrs <- runLayout (wksp {W.stack = filtStack}) (slaveRect rect n bias)
return ((divideRow (masterRect rect n bias) master) ++ (fst wrs),
snd wrs)
return $ first (divideRow (masterRect rect n bias) master ++)
wrs
-- | Calculates height of master area, depending on number of windows.
masterHeight :: Int -> Float -> Float
masterHeight n bias = (calcHeight n) + bias
masterHeight n bias = calcHeight n + bias
where calcHeight :: Int -> Float
calcHeight 1 = 1.0
calcHeight m = if (m<9) then (43/45) - (fromIntegral m)*(7/90) else (1/3)
calcHeight m = if m<9 then (43/45) - fromIntegral m*(7/90) else 1/3
-- | Rectangle for master area
masterRect :: Rectangle -> Int -> Float -> Rectangle
masterRect (Rectangle sx sy sw sh) n bias = Rectangle sx sy sw h
where h = round $ (fromIntegral sh)*(masterHeight n bias)
where h = round $ fromIntegral sh*masterHeight n bias
-- | Rectangle for slave area
slaveRect :: Rectangle -> Int -> Float -> Rectangle
slaveRect (Rectangle sx sy sw sh) n bias = Rectangle sx (sy+mh) sw h
where mh = round $ (fromIntegral sh)*(masterHeight n bias)
h = round $ (fromIntegral sh)*(1-masterHeight n bias)
where mh = round $ fromIntegral sh*masterHeight n bias
h = round $ fromIntegral sh*(1-masterHeight n bias)
-- | Divide rectangle between windows
divideRow :: Rectangle -> [a] -> [(a, Rectangle)]
@ -120,4 +122,3 @@ autoMaster :: LayoutClass l a =>
l a ->
ModifiedLayout AutoMaster l a
autoMaster nmaster delta = ModifiedLayout (AutoMaster nmaster 0 delta)

View File

@ -1,4 +1,4 @@
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, TupleSections #-}
-----------------------------------------------------------------------------
-- |
@ -26,7 +26,7 @@ module XMonad.Layout.AvoidFloats (
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Prelude (fi, maximumBy, maybeToList, sortBy)
import XMonad.Prelude (fi, mapMaybe, maximumBy, sortOn)
import qualified XMonad.StackSet as W
import Data.Ord
@ -107,10 +107,10 @@ instance LayoutModifier AvoidFloats Window where
modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
floating <- gets $ W.floating . windowset
case cache lm of
Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer
Just (key, mer) | key == (floating,r) -> (, Nothing) <$> runLayout w mer
_ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
(, Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
where
toRect :: WindowAttributes -> Rectangle
toRect wa = let b = fi $ wa_border_width wa
@ -122,9 +122,9 @@ instance LayoutModifier AvoidFloats Window where
shouldAvoid a = avoidAll lm || a `S.member` chosen lm
pureMess lm m
| Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
| Just AvoidFloatToggle <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
| Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing }
| Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
| Just AvoidFloatClearItems <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
| Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing }
| Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing }
| Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert
@ -134,7 +134,7 @@ instance LayoutModifier AvoidFloats Window where
pruneWindows :: AvoidFloats Window -> AvoidFloats Window
pruneWindows lm = case cache lm of
Nothing -> lm
Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) }
Just ((floating,_),_) -> lm { chosen = S.filter (`M.member` floating) (chosen lm) }
-- | Find all maximum empty rectangles (MERs) that are axis aligned. This is
-- done in O(n^2) time using a modified version of the algoprithm MERAlg 1
@ -144,9 +144,9 @@ maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge
where
upAndDownEdge = findGaps br rectangles
noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms
downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms
bottoms = sortBy (comparing bottom) $ splitContainers rectangles
noneOrUpEdge = concatMap (everyLower br bottoms) bottoms
downEdge = mapMaybe (bottomEdge br bottoms) bottoms
bottoms = sortOn bottom $ splitContainers rectangles
everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms
@ -177,8 +177,8 @@ shrinkBounds' mr r (boundLeft, boundRight)
bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms
boundLeft = maximum $ left br : (filter (< right r) $ map right rs)
boundRight = minimum $ right br : (filter (> left r) $ map left rs)
boundLeft = maximum $ left br : filter (< right r) (map right rs)
boundRight = minimum $ right br : filter (> left r) (map left rs)
in if any (\a -> left a <= left r && right r <= right a) rs
then Nothing
else mkRect boundLeft boundRight (bottom r) (bottom br)
@ -186,11 +186,11 @@ bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a <
-- | Split rectangles that horizontally fully contains another rectangle
-- without sharing either the left or right side.
splitContainers :: [Rectangle] -> [Rectangle]
splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects
splitContainers rects = splitContainers' [] $ sortOn rect_width rects
where
splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
splitContainers' res [] = res
splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs
splitContainers' res (r:rs) = splitContainers' (r:res) $ concatMap (doSplit r) rs
doSplit :: Rectangle -> Rectangle -> [Rectangle]
doSplit guide r
@ -206,7 +206,7 @@ findGaps
:: Rectangle -- ^ Bounding rectangle.
-> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle.
-> [Rectangle]
findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs
findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortOn (Down . left) $ filter inBounds rs
lastgap = mkRect end (right br) (top br) (bottom br)
in lastgap?:gaps
where

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.BinaryColumn
@ -86,7 +86,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
m_fl = fromIntegral m
m_prev_fl = fromIntegral (m + 1)
div_test = min divide m_prev_fl
value_test = round ((fromIntegral size) / div_test) :: Integer
value_test = round (fromIntegral size / div_test) :: Integer
value_max = size - toInteger (min_size * m)
(value, divide_next, no_room) =
if value_test < value_max then
@ -101,7 +101,7 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
-- simply create an even grid with the remaining space.
f m size divide True = let
divide_next = fromIntegral m
value_even = ((fromIntegral size) / divide)
value_even = (fromIntegral size / divide)
value = round value_even :: Integer
m_next = m - 1
@ -112,21 +112,21 @@ columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
n_init size_init divide_init False
where
n_init = n - 1
size_init = (toInteger (rect_height rect))
size_init = toInteger (rect_height rect)
divide_init =
if scale_abs == 0.0 then
(fromIntegral n)
fromIntegral n
else
(1.0 / (0.5 * scale_abs))
1.0 / (0.5 * scale_abs)
heights =
if (scale < 0.0) then
if scale < 0.0 then
Data.List.reverse (take n heights_noflip)
else
heights_noflip
ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]
rects = map (mkRect rect) $ zip heights ys
rects = zipWith (curry (mkRect rect)) heights ys
mkRect :: XMonad.Rectangle
-> (Integer,XMonad.Position)

View File

@ -157,7 +157,7 @@ instance Message SelectMoveNode
data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
-- | Message for shifting window by splitting its neighbour
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
newtype SplitShiftDirectional = SplitShift Direction1D deriving Typeable
instance Message SplitShiftDirectional
oppositeDirection :: Direction2D -> Direction2D
@ -253,9 +253,7 @@ goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight
goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft
top :: Zipper a -> Zipper a
top z = case goUp z of
Nothing -> z
Just z' -> top z'
top z = maybe z top (goUp z)
toTree :: Zipper a -> Tree a
toTree = fst . top
@ -283,10 +281,10 @@ removeCurrent :: Zipper a -> Maybe (Zipper a)
removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs)
removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs)
removeCurrent (Leaf _, []) = Nothing
removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs)
removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs)
removeCurrent (Node _ (Leaf _) r@Node{}, cs) = Just (r, cs)
removeCurrent (Node _ l@Node{} (Leaf _), cs) = Just (l, cs)
removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs)
removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent
removeCurrent z@(Node{}, _) = goLeft z >>= removeCurrent
rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
rotateCurrent l@(_, []) = Just l
@ -297,23 +295,23 @@ swapCurrent l@(_, []) = Just l
swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
insertLeftLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)
insertLeftLeaf (Node _ _ _) z = Just z
insertLeftLeaf Node{} z = Just z
insertLeftLeaf _ _ = Nothing
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
insertRightLeaf (Leaf n) (Node x l r, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)
insertRightLeaf (Node _ _ _) z = Just z
insertRightLeaf Node{} z = Just z
insertRightLeaf _ _ = Nothing
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf
findRightLeaf n@(Node{}, _) = goRight n >>= findRightLeaf
findRightLeaf l@(Leaf _, _) = Just l
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf n@(Node _ _ _, _) = goLeft n
findLeftLeaf n@(Node{}, _) = goLeft n
findLeftLeaf l@(Leaf _, _) = Just l
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
@ -508,7 +506,7 @@ toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) []
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
nodeRefToLeaf n (Just z) = case goToNode n z of
Just (Leaf l, _) -> Just l
Just (Node _ _ _, _) -> Nothing
Just (Node{}, _) -> Nothing
Nothing -> Nothing
nodeRefToLeaf _ Nothing = Nothing
@ -693,13 +691,13 @@ replaceFloating wsm = do
-- some helpers to filter windows
--
getFloating :: X [Window]
getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows
getFloating = M.keys . W.floating <$> gets windowset -- all floating windows
getStackSet :: X (Maybe (W.Stack Window))
getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating)
getStackSet = W.stack . W.workspace . W.current <$> gets windowset -- windows on this WS (with floating)
getScreenRect :: X Rectangle
getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset
getScreenRect = screenRect . W.screenDetail . W.current <$> gets windowset
withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
withoutFloating fs = maybe Nothing (unfloat fs)
@ -772,8 +770,8 @@ instance LayoutClass BinarySpacePartition Window where
splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b
b = numerateLeaves b_orig
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}
,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}}
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf= -1}
,getSelectedNode=(getSelectedNode bsp){refLeaf= -1}}
description _ = "BSP"
@ -850,8 +848,8 @@ createBorder (Rectangle wx wy ww wh) c = do
]
ws <- mapM (\r -> createNewWindow r Nothing bc False) rects
showWindows ws
maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack
M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating
replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) =<< getStackSet
replaceFloating . M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset =<< get
modify (\s -> s{mapped=mapped s `S.union` S.fromList ws})
-- show <$> mapM isClient ws >>= debug
return ws
@ -861,6 +859,6 @@ createBorder (Rectangle wx wy ww wh) c = do
removeBorder :: [Window] -> X ()
removeBorder ws = do
modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws})
flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating
maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack
replaceFloating . flip (foldl (flip M.delete)) ws . W.floating . windowset =<< get
replaceStack . maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) =<< getStackSet
deleteWindows ws

View File

@ -57,7 +57,7 @@ data BorderInfo = BI { bWin :: Window,
type RectWithBorders = (Rectangle, [BorderInfo])
data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
brBorderSize :: Dimension
brBorderSize = 2
@ -99,7 +99,7 @@ instance LayoutModifier BorderResize Window where
compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
compileWrs wrsThisTime correctOrder = let wrs = reorder (M.toList wrsThisTime) correctOrder
in concat $ map compileWr wrs
in concatMap compileWr wrs
compileWr :: (Window, RectWithBorders) -> [(Window, Rectangle)]
compileWr (w, (r, borderInfos)) =
@ -109,7 +109,7 @@ compileWr (w, (r, borderInfos)) =
handleGone :: M.Map Window RectWithBorders -> X ()
handleGone wrsGone = mapM_ deleteWindow borderWins
where
borderWins = map bWin . concat . map snd . M.elems $ wrsGone
borderWins = map bWin . concatMap snd . M.elems $ wrsGone
handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders)
handleAppeared wrsAppeared = do
@ -124,58 +124,58 @@ handleSingleAppeared (w, r) = do
return (w, (r, borderInfos))
handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders
handleStillThere wrsStillThere = M.map handleSingleStillThere wrsStillThere
handleStillThere = M.map handleSingleStillThere
handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders
handleSingleStillThere (Nothing, entry) = entry
handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)
where
changedBorderBlueprints = prepareBorders rCurrent
updatedBorderInfos = map updateBorderInfo . zip borderInfos $ changedBorderBlueprints
updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints
-- assuming that the four borders are always in the same order
updateBorderInfo :: (BorderInfo, BorderBlueprint) -> BorderInfo
updateBorderInfo (borderInfo, (r, _, _)) = borderInfo { bRect = r }
createBorderLookupTable :: M.Map Window RectWithBorders -> [(Window, (BorderType, Window, Rectangle))]
createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList wrsLastTime
createBorderLookupTable wrsLastTime = concatMap processSingleEntry (M.toList wrsLastTime)
where
processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]
processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r))
prepareBorders :: Rectangle -> [BorderBlueprint]
prepareBorders (Rectangle x y wh ht) =
[((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)
[(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 ()
handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
| et == buttonPress, Just edge <- lookup ew borders =
case edge of
(RightSideBorder, hostWin, (Rectangle hx hy _ hht)) ->
(RightSideBorder, hostWin, Rectangle hx hy _ hht) ->
mouseDrag (\x _ -> do
let nwh = max 1 $ fi (x - hx)
rect = Rectangle hx hy nwh hht
focus hostWin
when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
(LeftSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->
(LeftSideBorder, hostWin, Rectangle hx hy hwh hht) ->
mouseDrag (\x _ -> do
let nx = max 0 $ min (hx + fi hwh) $ x
let nx = max 0 $ min (hx + fi hwh) x
nwh = max 1 $ hwh + fi (hx - x)
rect = Rectangle nx hy nwh hht
focus hostWin
when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin)
(TopSideBorder, hostWin, (Rectangle hx hy hwh hht)) ->
(TopSideBorder, hostWin, Rectangle hx hy hwh hht) ->
mouseDrag (\_ y -> do
let ny = max 0 $ min (hy + fi hht) $ y
let ny = max 0 $ min (hy + fi hht) y
nht = max 1 $ hht + fi (hy - y)
rect = Rectangle hx ny hwh nht
focus hostWin
when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin)
(BottomSideBorder, hostWin, (Rectangle hx hy hwh _)) ->
(BottomSideBorder, hostWin, Rectangle hx hy hwh _) ->
mouseDrag (\_ y -> do
let nht = max 1 $ fi (y - hy)
rect = Rectangle hx hy hwh nht
@ -183,7 +183,7 @@ handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et }
when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin)
handleResize _ _ = return ()
createBorder :: BorderBlueprint -> X (BorderInfo)
createBorder :: BorderBlueprint -> X BorderInfo
createBorder (borderRect, borderCursor, borderType) = do
borderWin <- createInputWindow borderCursor borderRect
return BI { bWin = borderWin, bRect = borderRect, bType = borderType }
@ -214,10 +214,10 @@ for = flip map
reorder :: (Eq a) => [(a, b)] -> [a] -> [(a, b)]
reorder wrs order =
let ordered = concat $ map (pickElem wrs) order
rest = filter (\(w, _) -> not (w `elem` order)) wrs
let ordered = concatMap (pickElem wrs) order
rest = filter (\(w, _) -> w `notElem` order) wrs
in ordered ++ rest
where
pickElem list e = case (lookup e list) of
pickElem list e = case lookup e list of
Just result -> [(e, result)]
Nothing -> []

View File

@ -1,4 +1,4 @@
{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
@ -36,7 +36,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
broadcastMessage, sendMessage, windows, withFocused, Window)
import XMonad.Prelude (fromMaybe, listToMaybe, maybeToList, union, (\\))
import XMonad.Prelude (find, fromMaybe, listToMaybe, maybeToList, union, (\\))
import XMonad.Util.Stack (reverseS)
import qualified Data.Map as M
import qualified XMonad.StackSet as W
@ -110,13 +110,13 @@ boringAuto :: (LayoutClass l a, Eq a) => l a -> ModifiedLayout BoringWindows l a
boringAuto = ModifiedLayout (BoringWindows M.empty [] (Just []))
instance LayoutModifier BoringWindows Window where
redoLayout (b@BoringWindows { hiddenBoring = bs }) _r mst arrs = do
redoLayout b@BoringWindows{ hiddenBoring = bs } _r mst arrs = do
let bs' = W.integrate' mst \\ map fst arrs
return (arrs, Just $ b { hiddenBoring = const bs' <$> bs } )
return (arrs, Just $ b { hiddenBoring = bs' <$ bs } )
handleMessOrMaybeModifyIt bst@(BoringWindows nbs cbs lbs) m
| Just (Replace k ws) <- fromMessage m
, maybe True (ws/=) (M.lookup k nbs) =
, Just ws /= M.lookup k nbs =
let nnb = if null ws then M.delete k nbs
else M.insert k ws nbs
in rjl bst { namedBoring = nnb }
@ -155,8 +155,8 @@ instance LayoutModifier BoringWindows Window where
skipBoringSwapUp = skipBoring'
(maybe True (`notElem` bs) . listToMaybe . W.down)
swapUp'
skipBoring' p f st = fromMaybe st $ listToMaybe
$ filter p
skipBoring' p f st = fromMaybe st
$ find p
$ drop 1
$ take (length $ W.integrate st)
$ iterate f st

View File

@ -48,7 +48,7 @@ buttonDeco :: (Eq a, Shrinker s) => s -> Theme
-> l a -> ModifiedLayout (Decoration ButtonDecoration s) l a
buttonDeco s c = decoration s c $ NFD True
data ButtonDecoration a = NFD Bool deriving (Show, Read)
newtype ButtonDecoration a = NFD Bool deriving (Show, Read)
instance Eq a => DecorationStyle ButtonDecoration a where
describeDeco _ = "ButtonDeco"

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.CenteredMaster
@ -29,6 +29,8 @@ import XMonad
import XMonad.Layout.LayoutModifier
import qualified XMonad.StackSet as W
import Control.Arrow (first)
-- $usage
-- This module defines two new layout modifiers: centerMaster and topRightMaster.
-- centerMaster places master window at center of screen, on top of others.
@ -76,15 +78,15 @@ applyPosition :: (LayoutClass l a, Eq a) =>
applyPosition pos wksp rect = do
let stack = W.stack wksp
let ws = W.integrate' $ stack
let ws = W.integrate' stack
if null ws then
runLayout wksp rect
else do
let first = head ws
let firstW = head ws
let other = tail ws
let filtStack = stack >>= W.filter (first /=)
let filtStack = stack >>= W.filter (firstW /=)
wrs <- runLayout (wksp {W.stack = filtStack}) rect
return ((first, place pos other rect) : fst wrs, snd wrs)
return $ first ((firstW, place pos other rect) :) wrs
-- | Place master window (it's Rectangle is given), using the given Positioner.
-- If second argument is empty (that is, there is only one window on workspace),
@ -107,5 +109,3 @@ center rx ry (Rectangle sx sy sw sh) = Rectangle x y w h
h = round (fromIntegral sh * ry)
x = sx + fromIntegral (sw-w) `div` 2
y = sy + fromIntegral (sh-h) `div` 2

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |

View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.Column
@ -40,7 +40,7 @@ import qualified XMonad.StackSet as W
-- In this example, each next window will have height 1.6 times less then
-- previous window.
data Column a = Column Float deriving (Read,Show)
newtype Column a = Column Float deriving (Read,Show)
instance LayoutClass Column a where
pureLayout = columnLayout
@ -57,15 +57,13 @@ columnLayout (Column q) rect stack = zip ws rects
n = length ws
heights = map (xn n rect q) [1..n]
ys = [fromIntegral $ sum $ take k heights | k <- [0..n-1]]
rects = map (mkRect rect) $ zip heights ys
rects = zipWith (curry (mkRect rect)) heights ys
mkRect :: Rectangle -> (Dimension,Position) -> Rectangle
mkRect (Rectangle xs ys ws _) (h,y) = Rectangle xs (ys+fromIntegral y) ws h
xn :: Int -> Rectangle -> Float -> Int -> Dimension
xn n (Rectangle _ _ _ h) q k = if q==1 then
h `div` (fromIntegral n)
h `div` fromIntegral n
else
round ((fromIntegral h)*q^(n-k)*(1-q)/(1-q^n))
round (fromIntegral h*q^(n-k)*(1-q)/(1-q^n))

View File

@ -23,7 +23,7 @@ module XMonad.Layout.Combo (
) where
import XMonad hiding (focus)
import XMonad.Prelude (delete, intersect, isJust, (\\))
import XMonad.Prelude (delete, fromMaybe, intersect, isJust, (\\))
import XMonad.StackSet ( integrate', Workspace (..), Stack(..) )
import XMonad.Layout.WindowNavigation ( MoveWindowToWindow(..) )
import qualified XMonad.StackSet as W ( differentiate )
@ -76,14 +76,14 @@ combineTwo = C2 [] []
instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
=> LayoutClass (CombineTwo (l ()) l1 l2) a where
runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
where arrange [] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- fromMaybe super <$>
handleMessage super (SomeMessage ReleaseResources)
return ([], Just $ C2 [] [] super' l1' l2')
arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- maybe super id <$>
arrange [w] = do l1' <- fromMaybe l1 <$> handleMessage l1 (SomeMessage ReleaseResources)
l2' <- fromMaybe l2 <$> handleMessage l2 (SomeMessage ReleaseResources)
super' <- fromMaybe super <$>
handleMessage super (SomeMessage ReleaseResources)
return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
arrange origws =
@ -101,17 +101,17 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
return (wrs1++wrs2, Just $ C2 f' w2'
(maybe super id msuper') (maybe l1 id ml1') (maybe l2 id ml2'))
(fromMaybe super msuper') (fromMaybe l1 ml1') (fromMaybe l2 ml2'))
handleMessage (C2 f ws2 super l1 l2) m
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `notElem` ws2,
w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
w2 `elem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m
l2' <- fromMaybe l2 <$> handleMessage l2 m
return $ Just $ C2 f (w1:ws2) super l1' l2'
| Just (MoveWindowToWindow w1 w2) <- fromMessage m,
w1 `elem` ws2,
w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
l2' <- maybe l2 id <$> handleMessage l2 m
w2 `notElem` ws2 = do l1' <- fromMaybe l1 <$> handleMessage l1 m
l2' <- fromMaybe l2 <$> handleMessage l2 m
let ws2' = case delete w1 ws2 of [] -> [w2]
x -> x
return $ Just $ C2 f ws2' super l1' l2'
@ -138,6 +138,6 @@ differentiate [] xs = W.differentiate xs
broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
broadcastPrivate a ol = do nml <- mapM f ol
if any isJust nml
then return $ Just $ zipWith ((flip maybe) id) ol nml
then return $ Just $ zipWith (`maybe` id) ol nml
else return Nothing
where f l = handleMessage l a `catchX` return Nothing

View File

@ -1,4 +1,4 @@
{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.ComboP
@ -97,7 +97,7 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
superstack = Just Stack { focus=(), up=[], down=[()] }
f' = focus s:delete (focus s) f -- list of focused windows, contains 2 elements at most
in do
matching <- (hasProperty prop) `filterM` new -- new windows matching predecate
matching <- hasProperty prop `filterM` new -- new windows matching predecate
let w1' = w1c ++ matching -- updated first pane windows
w2' = w2c ++ (new \\ matching) -- updated second pane windows
s1 = differentiate f' w1' -- first pane stack
@ -105,8 +105,8 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
([((),r1),((),r2)], msuper') <- runLayout (Workspace "" super superstack) rinput
(wrs1, ml1') <- runLayout (Workspace "" l1 s1) r1
(wrs2, ml2') <- runLayout (Workspace "" l2 s2) r2
return (wrs1++wrs2, Just $ C2P f' w1' w2' (maybe super id msuper')
(maybe l1 id ml1') (maybe l2 id ml2') prop)
return (wrs1++wrs2, Just $ C2P f' w1' w2' (fromMaybe super msuper')
(fromMaybe l1 ml1') (fromMaybe l2 ml2') prop)
handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
| Just PartitionWins <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop
@ -127,13 +127,13 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
msuper' <- handleMessage super m
if isJust msuper' || isJust ml1' || isJust ml2'
then return $ Just $ C2P f ws1 ws2
(maybe super id msuper')
(maybe l1 id ml1')
(maybe l2 id ml2') prop
(fromMaybe super msuper')
(fromMaybe l1 ml1')
(fromMaybe l2 ml2') prop
else return Nothing
description (C2P _ _ _ super l1 l2 prop) = "combining " ++ description l1 ++ " and "++
description l2 ++ " with " ++ description super ++ " using "++ (show prop)
description l2 ++ " with " ++ description super ++ " using "++ show prop
-- send focused window to the other pane. Does nothing if we don't
-- own the focused window
@ -164,7 +164,7 @@ forwardToFocused (C2P f ws1 ws2 super l1 l2 prop) m = do
then return Nothing
else handleMessage super m
if isJust ml1 || isJust ml2 || isJust ms
then return $ Just $ C2P f ws1 ws2 (maybe super id ms) (maybe l1 id ml1) (maybe l2 id ml2) prop
then return $ Just $ C2P f ws1 ws2 (fromMaybe super ms) (fromMaybe l1 ml1) (fromMaybe l2 ml2) prop
else return Nothing
-- forwards message m to layout l if focused window is among w
@ -172,7 +172,7 @@ forwardIfFocused :: (LayoutClass l Window) => l Window -> [Window] -> SomeMessag
forwardIfFocused l w m = do
mst <- gets (W.stack . W.workspace . W.current . windowset)
maybe (return Nothing) send mst where
send st = if (W.focus st) `elem` w
send st = if W.focus st `elem` w
then handleMessage l m
else return Nothing

View File

@ -34,7 +34,7 @@ import XMonad.Prelude( msum )
-- apply a factor to a Rectangle Dimension
(<%>) :: Dimension -> Rational -> Dimension
d <%> f = floor $ f * (fromIntegral d)
d <%> f = floor $ f * fromIntegral d
-- | The Cross Layout draws the focused window in the center of the screen
-- and part of the other windows on the sides. The 'Shrink' and 'Expand'
@ -57,10 +57,10 @@ simpleCross :: Cross a
simpleCross = Cross (4/5) (1/100)
instance LayoutClass Cross a where
pureLayout (Cross f _) r s = [(focus s, mainRect r f)] ++
(zip winCycle (upRects r f)) ++
(zip (reverse winCycle) (downRects r f))
where winCycle = (up s) ++ (reverse (down s))
pureLayout (Cross f _) r s = [(focus s, mainRect r f)]
++ zip winCycle (upRects r f)
++ zip (reverse winCycle) (downRects r f)
where winCycle = up s ++ reverse (down s)
pureMessage (Cross f d) m = msum [fmap resize (fromMessage m)]
where resize Shrink = Cross (max (1/100) $ f - d) d
@ -71,8 +71,8 @@ instance LayoutClass Cross a where
-- get the Rectangle for the focused window
mainRect :: Rectangle -> Rational -> Rectangle
mainRect (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> invf)))
(ry + (fromIntegral (rh <%> invf)))
(rx + fromIntegral (rw <%> invf))
(ry + fromIntegral (rh <%> invf))
(rw <%> f) (rh <%> f)
where invf = (1/2) * (1-f)
@ -88,25 +88,25 @@ downRects r f = [bottomRectangle r nf, leftRectangle r nf]
topRectangle :: Rectangle -> Rational -> Rectangle
topRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
(rx + fromIntegral (rw <%> ((1-f)*(1/2))))
ry
(rw <%> f) (rh <%> ((1-f)*(1/2)))
rightRectangle :: Rectangle -> Rational -> Rectangle
rightRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw - (rw <%> (1/2)))))
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
(rx + fromIntegral (rw - (rw <%> (1/2))))
(ry + fromIntegral (rh <%> ((1-f)*(1/2))))
(rw <%> (1/2)) (rh <%> f)
bottomRectangle :: Rectangle -> Rational -> Rectangle
bottomRectangle (Rectangle rx ry rw rh) f = Rectangle
(rx + (fromIntegral (rw <%> ((1-f)*(1/2)))))
(ry + (fromIntegral (rh - (rh <%> ((1-f)*(1/2))))))
(rx + fromIntegral (rw <%> ((1-f)*(1/2))))
(ry + fromIntegral (rh - (rh <%> ((1-f)*(1/2)))))
(rw <%> f) (rh <%> ((1-f)*(1/2)))
leftRectangle :: Rectangle -> Rational -> Rectangle
leftRectangle (Rectangle rx ry rw rh) f = Rectangle
rx
(ry + (fromIntegral (rh <%> ((1-f)*(1/2)))))
(ry + fromIntegral (rh <%> ((1-f)*(1/2))))
(rw <%> (1/2)) (rh <%> f)

Some files were not shown because too many files have changed in this diff Show More