From 2bee8de664327906945db65a7be4e628c72624b3 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Tue, 25 Sep 2007 19:44:17 +0200 Subject: make Combo work with class darcs-hash:20070925174417-72aca-2c2fa630e5dad47d830674799715bcf027d06022.gz --- Combo.hs | 69 ++++++++++++++++++++++++++++++++++++++++------------------------ 1 file changed, 43 insertions(+), 26 deletions(-) (limited to 'Combo.hs') diff --git a/Combo.hs b/Combo.hs index 73caa3b..1823410 100644 --- a/Combo.hs +++ b/Combo.hs @@ -1,3 +1,4 @@ +{-# OPTIONS -fallow-undecidable-instances #-} ----------------------------------------------------------------------------- -- | -- Module : XMonadContrib.Combo @@ -19,24 +20,25 @@ module XMonadContrib.Combo ( ) where import Control.Arrow ( first ) +import Data.List ( delete ) import Data.Maybe ( isJust ) import XMonad -import StackSet ( integrate, differentiate ) +import StackSet ( integrate, Stack(..) ) +import qualified StackSet as W ( differentiate ) -- $usage -- -- To use this layout write, in your Config.hs: -- -- > import XMonadContrib.Combo --- > import XMonadContrib.SimpleStacking -- -- and add something like -- --- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- > combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] -- -- to your defaultLayouts. -- --- The first argument to combo is a Layout that will divide the screen into +-- The first argument to combo is a layout that will divide the screen into -- one or more subscreens. The second argument is a list of layouts which -- will be used to lay out the contents of each of those subscreens. -- Paired with each of these layouts is an integer giving the number of @@ -44,33 +46,48 @@ import StackSet ( integrate, differentiate ) -- layout, which will hold any excess windows. -- %import XMonadContrib.Combo --- %import XMonadContrib.SimpleStacking --- %layout , simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] +-- %layout , combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText defaultTConf,1)] -combo :: Layout (Layout a, Int) -> [(Layout a, Int)] -> Layout a -combo super origls = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } - where arrange _ [] = return ([], Nothing) - arrange r [w] = return ([(w,r)], Nothing) - arrange rinput origws = - do (lrs, msuper') <- runLayout super rinput (differentiate $ take (length origws) origls) - let super' = maybe super id msuper' - lwrs [] _ = [] - lwrs [((l,_),r)] ws = [((l,r),differentiate ws)] - lwrs (((l,n),r):xs) ws = ((l,r),differentiate $ take len1 ws) : lwrs xs (drop len1 ws) - where len1 = min n (length ws - length xs) - out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws - let origls' = zipWith foo (out++repeat ([],Nothing)) origls - foo (_, Nothing) x = x - foo (_, Just l') (_, n) = (l', n) - return (concat $ map fst out, Just $ combo super' origls') - message m = do mls <- broadcastPrivate m (map fst origls) +combo :: (Eq a, Show a, Read a, ReadableSomeLayout a, Layout l (SomeLayout a, Int)) + => (l (SomeLayout a, Int)) -> [(SomeLayout a, Int)] -> Combo l a +combo = Combo [] + +data Combo l a = Combo [a] (l (SomeLayout a, Int)) [(SomeLayout a, Int)] + deriving ( Show, Read ) + +instance (Eq a, Show a, Read a, ReadableSomeLayout a, Layout l (SomeLayout a, Int)) + => Layout (Combo l) a where + doLayout (Combo f super origls) rinput s = arrange (integrate s) + where arrange [] = return ([], Just $ Combo [] super origls) + arrange [w] = return ([(w,rinput)], Just $ Combo [w] super origls) + arrange origws = + do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls) + let super' = maybe super id msuper' + f' = focus s:delete (focus s) f + lwrs [] _ = [] + lwrs [((l,_),r)] ws = [((l,r),differentiate f' ws)] + lwrs (((l,n),r):xs) ws = ((l,r),differentiate f' $ take len1 ws) : lwrs xs (drop len1 ws) + where len1 = min n (length ws - length xs) + out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws + let origls' = zipWith foo (out++repeat ([],Nothing)) origls + foo (_, Nothing) x = x + foo (_, Just l') (_, n) = (l', n) + return (concat $ map fst out, Just $ Combo f' super' origls') + differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q) + differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z + , up = reverse $ takeWhile (/=z) xs + , down = tail $ dropWhile (/=z) xs } + | otherwise = differentiate zs xs + differentiate [] xs = W.differentiate xs + modifyLayout (Combo f super origls) m = + do mls <- broadcastPrivate m (map fst origls) let mls' = (\x->zipWith first (map const x) origls) `fmap` mls msuper <- broadcastPrivate m [super] case msuper of - Just [super'] -> return $ Just $ combo super' $ maybe origls id mls' - _ -> return $ combo super `fmap` mls' + Just [super'] -> return $ Just $ Combo f super' $ maybe origls id mls' + _ -> return $ Combo f super `fmap` mls' -broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b]) +broadcastPrivate :: Layout 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 -- cgit v1.2.3