{-# LANGUAGE CPP, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, PatternGuards #-}
module XMonad.Layout.LimitWindows (
limitWindows,limitSlice,limitSelect,
increaseLimit,decreaseLimit,setLimit,
#ifdef TESTING
select,update,Selection(..),updateAndSelect,
#endif
LimitWindows, Selection,
) where
import XMonad.Layout.LayoutModifier
import XMonad
import qualified XMonad.StackSet as W
import Control.Monad((<=<),guard)
import Control.Applicative((<$>))
import Data.Maybe(fromJust)
increaseLimit :: X ()
increaseLimit = sendMessage $ LimitChange succ
decreaseLimit :: X ()
decreaseLimit = sendMessage . LimitChange $ max 1 . pred
setLimit :: Int -> X ()
setLimit tgt = sendMessage . LimitChange $ const tgt
limitWindows :: Int -> l a -> ModifiedLayout LimitWindows l a
limitWindows n = ModifiedLayout (LimitWindows FirstN n)
limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a
limitSlice n = ModifiedLayout (LimitWindows Slice n)
limitSelect :: Int -> Int -> l a -> ModifiedLayout Selection l a
limitSelect m r = ModifiedLayout Sel{ nMaster=m, start=m, nRest=r }
data LimitWindows a = LimitWindows SliceStyle Int deriving (Read,Show)
data SliceStyle = FirstN | Slice deriving (Read,Show)
data LimitChange = LimitChange { unLC :: (Int -> Int) } deriving (Typeable)
instance Message LimitChange
instance LayoutModifier LimitWindows a where
pureMess (LimitWindows s n) =
fmap (LimitWindows s) . pos <=< (`app` n) . unLC <=< fromMessage
where pos x = guard (x>=1) >> return x
app f x = guard (f x /= x) >> return (f x)
modifyLayout (LimitWindows style n) ws r =
runLayout ws { W.stack = f n <$> W.stack ws } r
where f = case style of
FirstN -> firstN
Slice -> slice
firstN :: Int -> W.Stack a -> W.Stack a
firstN n st = upfocus $ fromJust $ W.differentiate $ take (max 1 n) $ W.integrate st
where upfocus = foldr (.) id $ replicate (length (W.up st)) W.focusDown'
slice :: Int -> W.Stack t -> W.Stack t
slice n (W.Stack f u d) =
W.Stack f (take (nu + unusedD) u)
(take (nd + unusedU) d)
where unusedD = max 0 $ nd - length d
unusedU = max 0 $ nu - length u
nd = div (n - 1) 2
nu = uncurry (+) $ divMod (n - 1) 2
data Selection a = Sel { nMaster :: Int, start :: Int, nRest :: Int }
deriving (Read, Show, Eq)
instance LayoutModifier Selection a where
modifyLayout s w r =
runLayout (w { W.stack = updateAndSelect s <$> W.stack w }) r
pureModifier sel _ stk wins = (wins, update sel <$> stk)
pureMess sel m
| Just f <- unLC <$> fromMessage m =
Just $ sel { nRest = max 0 (f (nMaster sel + nRest sel) - nMaster sel) }
| Just (IncMasterN n) <- fromMessage m =
Just $ sel { nMaster = max 0 (nMaster sel + n) }
| otherwise =
Nothing
select :: Selection l -> W.Stack a -> W.Stack a
select s stk
| lups < nMaster s
= stk { W.down=take (nMaster s - lups - 1) downs ++
(take (nRest s) . drop (start s - lups - 1) $ downs) }
| otherwise
= stk { W.up=reverse (take (nMaster s) ups ++ drop (start s) ups),
W.down=take ((nRest s) - (lups - start s) - 1) downs }
where
downs = W.down stk
ups = reverse $ W.up stk
lups = length ups
updateStart :: Selection l -> W.Stack a -> Int
updateStart s stk
| lups < nMaster s
= start s `min` (lups + ldown - (nRest s) + 1) `max` nMaster s
| otherwise
= start s `min` lups
`max` (lups - (nRest s) + 1)
`min` (lups + ldown - (nRest s) + 1)
`max` nMaster s
where
lups = length $ W.up stk
ldown = length $ W.down stk
update :: Selection l -> W.Stack a -> Selection a
update sel stk = sel { start=updateStart sel stk }
updateAndSelect :: Selection l -> W.Stack a -> W.Stack a
updateAndSelect sel stk = select (update sel stk) stk