diff options
author | David Roundy <droundy@darcs.net> | 2007-09-25 19:44:17 +0200 |
---|---|---|
committer | David Roundy <droundy@darcs.net> | 2007-09-25 19:44:17 +0200 |
commit | 2bee8de664327906945db65a7be4e628c72624b3 (patch) | |
tree | 284a3ad6f3126f4c8d1797edd62d7d41a4d26ce2 | |
parent | bcefc4d1bed3017506eadf3e181d5ac23a426e1f (diff) | |
download | XMonadContrib-2bee8de664327906945db65a7be4e628c72624b3.tar.gz XMonadContrib-2bee8de664327906945db65a7be4e628c72624b3.tar.xz XMonadContrib-2bee8de664327906945db65a7be4e628c72624b3.zip |
make Combo work with class
darcs-hash:20070925174417-72aca-2c2fa630e5dad47d830674799715bcf027d06022.gz
Diffstat (limited to '')
-rw-r--r-- | Combo.hs | 69 |
1 files changed, 43 insertions, 26 deletions
@@ -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 |