From 0baf697296799f0146093287d9455c4a2dcef8f2 Mon Sep 17 00:00:00 2001 From: Max Rabkin Date: Wed, 14 Oct 2009 22:22:13 +0200 Subject: Move limitSelect into L.LimitWindows Ignore-this: 51d6e9da4a6a4f683cd145371e90be17 darcs-hash:20091014202213-a5338-1896e12a9c253692e03c0ac1d624fe0e26312e21.gz --- XMonad/Layout/LimitWindows.hs | 68 ++++++++++++++++++++++-- XMonad/Layout/Selective.hs | 118 ------------------------------------------ 2 files changed, 63 insertions(+), 123 deletions(-) delete mode 100644 XMonad/Layout/Selective.hs (limited to 'XMonad/Layout') diff --git a/XMonad/Layout/LimitWindows.hs b/XMonad/Layout/LimitWindows.hs index 61b6164..c3d3def 100644 --- a/XMonad/Layout/LimitWindows.hs +++ b/XMonad/Layout/LimitWindows.hs @@ -1,8 +1,9 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, NamedFieldPuns, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.LimitWindows -- Copyright : (c) 2009 Adam Vogt +-- (c) 2009 Max Rabkin -- wrote limitSelect -- License : BSD-style (see xmonad/LICENSE) -- -- Maintainer : vogt.adam@gmail.com @@ -17,17 +18,19 @@ module XMonad.Layout.LimitWindows ( -- * Usage -- $usage - -- Layout Modifiers - limitWindows,limitSlice, + -- * Layout Modifiers + limitWindows,limitSlice,limitSelect, - -- Change the number of windows + -- * Change the number of windows increaseLimit,decreaseLimit,setLimit ) where import XMonad.Layout.LayoutModifier import XMonad import qualified XMonad.StackSet as W +import XMonad.Layout (IncMasterN (..)) import Control.Monad((<=<),guard) +import Control.Applicative((<$>)) import Data.Maybe(fromJust) -- $usage @@ -66,6 +69,12 @@ limitWindows n = ModifiedLayout (LimitWindows FirstN n) limitSlice :: Int -> l a -> ModifiedLayout LimitWindows l a limitSlice n = ModifiedLayout (LimitWindows Slice n) +-- | Only display the first @m@ windows and @r@ others. +-- The @IncMasterN@ message will change @m@, as well as passing it onto the +-- underlying layout. +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) @@ -81,7 +90,7 @@ instance LayoutModifier LimitWindows a where app f x = guard (f x /= x) >> return (f x) modifyLayout (LimitWindows style n) ws r = - runLayout ws { W.stack = f n `fmap` W.stack ws } r + runLayout ws { W.stack = f n <$> W.stack ws } r where f = case style of FirstN -> firstN Slice -> slice @@ -99,3 +108,52 @@ slice n (W.Stack f u 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 (Sel { nMaster, start, nRest }) stk + | lups < nMaster + = stk { W.down=take (nMaster - lups - 1) downs ++ + (take nRest . drop (start - lups - 1) $ downs) } + | otherwise + = stk { W.up=reverse (take nMaster ups ++ drop start ups), + W.down=take (nRest - (lups - start) - 1) downs } + where + downs = W.down stk + ups = reverse $ W.up stk + lups = length ups + +updateStart :: Selection l -> W.Stack a -> Int +updateStart (Sel { nMaster, start, nRest }) stk + | lups < nMaster -- the focussed window is in the master pane + = start `min` (lups + ldown - nRest + 1) `max` nMaster + | otherwise + = start `min` lups + `max` (lups - nRest + 1) + `min` (lups + ldown - nRest + 1) + `max` nMaster + 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 diff --git a/XMonad/Layout/Selective.hs b/XMonad/Layout/Selective.hs deleted file mode 100644 index 2999d34..0000000 --- a/XMonad/Layout/Selective.hs +++ /dev/null @@ -1,118 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : XMonad.Layout.Selective --- Copyright : (c) 2009 Max Rabkin --- License : BSD3-style (see LICENSE) --- --- Maintainer : Max Rabkin --- Stability : unstable --- Portability : unportable --- --- Provides a layout modifier that only shows the master pane and windows --- around the focussed window. --- ------------------------------------------------------------------------------ - -{-# LANGUAGE MultiParamTypeClasses, - FlexibleInstances, - NoMonomorphismRestriction, - NamedFieldPuns #-} - -module XMonad.Layout.Selective ( - -- * Description - -- $description - -- * Usage - -- $usage - - -- The Layout Modifier - selective - ) where - -import XMonad.Core -import XMonad.StackSet -import XMonad.Layout (IncMasterN (..)) -import XMonad.Layout.LayoutModifier -import Control.Applicative ((<$>)) - --- $description --- Selective is a layout modifier which limits the number of windows on screen. --- The first @n@ windows ("the master pane", which may correspond to the --- master pane of the underlying layout) plus several others are shown, such --- that the focussed window is always visible. Windows are not moved until a --- hidden window gains focus. - --- $usage --- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Layout.Selective --- --- > myLayout = (selective 1 3 $ Tall 1 0.03 0.5) ||| Full ||| RandomOtherLayout... --- > main = xmonad defaultConfig { layoutHook = myLayout } --- --- The layout modifier accepts the IncMasterN message to change the number of --- windows in the "master pane". --- --- For detailed instructions on editing your key bindings, see --- "XMonad.Doc.Extending#Editing_key_bindings". --- --- See also 'XMonad.Layout.BoringWindows.boringAuto' for keybindings that skip --- the hidden windows. - --- invariant: 0 <= nMaster <= start; 1 <= nRest -data Selection = Sel { nMaster :: Int, start :: Int, nRest :: Int } - deriving (Read, Show, Eq) - -select :: Selection -> Stack a -> Stack a -select (Sel { nMaster, start, nRest }) stk - | lups < nMaster - = stk { down=take (nMaster - lups - 1) downs ++ - (take nRest . drop (start - lups - 1) $ downs) } - | otherwise - = stk { up=reverse (take nMaster ups ++ drop start ups), - down=take (nRest - (lups - start) - 1) downs } - where - downs = down stk - ups = reverse $ up stk - lups = length ups - -updateStart :: Selection -> Stack a -> Int -updateStart (Sel { nMaster, start, nRest }) stk - | lups < nMaster -- the focussed window is in the master pane - = start `min` (lups + ldown - nRest + 1) `max` nMaster - | otherwise - = start `min` lups - `max` (lups - nRest + 1) - `min` (lups + ldown - nRest + 1) - `max` nMaster - where - lups = length $ up stk - ldown = length $ down stk - -update :: Selection -> Stack a -> Selection -update sel stk = sel { start=updateStart sel stk } - -updateAndSelect :: Selection -> Stack a -> Stack a -updateAndSelect sel stk = select (update sel stk) stk - -data Selective a = Selective Selection - deriving (Read, Show) - -instance LayoutModifier Selective a where - modifyLayout (Selective s) w r = - runLayout (w { stack = updateAndSelect s <$> stack w }) r - - pureModifier (Selective sel) _ stk wins = (wins, Selective . update sel <$> stk) - - pureMess (Selective s) m = Selective . incmastern <$> fromMessage m - where - incmastern (IncMasterN n) = - let nm = (nMaster s + n) `max` 0 - in if nMaster s == start s - then s { nMaster = nm, start = nm } - else s { nMaster = nm } - --- | Only display the first @m@ windows and @r@ others. --- The @IncMasterN@ message will change @m@, as well as passing it onto the --- underlying layout. -selective :: Int -> Int -> l a -> ModifiedLayout Selective l a -selective m r = ModifiedLayout . Selective $ Sel { nMaster=m, start=m, nRest=r } -- cgit v1.2.3