diff options
Diffstat (limited to 'XMonad')
| -rw-r--r-- | XMonad/Layout/MultiToggle.hs | 93 | ||||
| -rw-r--r-- | XMonad/Layout/MultiToggle/Instances.hs | 11 | ||||
| -rw-r--r-- | XMonad/Layout/Reflect.hs | 4 |
3 files changed, 40 insertions, 68 deletions
diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs index ebf41b0..46716a4 100644 --- a/XMonad/Layout/MultiToggle.hs +++ b/XMonad/Layout/MultiToggle.hs @@ -41,11 +41,6 @@ import Data.Maybe -- first disables any currently active transformer; i.e. it works like a -- group of radio buttons. -- --- A side effect of this meta-layout is that layout transformers no longer --- receive any messages; any message not handled by MultiToggle itself will --- undo the current layout transformer, pass the message on to the base --- layout, then reapply the transformer. --- -- To use this module, you need some data types which represent -- transformers; for some commonly used transformers (including -- MIRROR, NOBORDERS, and FULL used in the examples below) you can @@ -89,7 +84,7 @@ import Data.Maybe -- -- > data MIRROR = MIRROR deriving (Read, Show, Eq, Typeable) -- > instance Transformer MIRROR Window where --- > transform _ x k = k (Mirror x) +-- > transform _ x k = k (Mirror x) (\(Mirror x') -> x') -- -- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the -- beginning of your file. @@ -97,15 +92,19 @@ import Data.Maybe -- | A class to identify custom transformers (and look up transforming -- functions by type). class (Eq t, Typeable t) => Transformer t a | t -> a where - transform :: (LayoutClass l a) => t -> l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b + transform :: (LayoutClass l a) => t -> l a -> + (forall l'. (LayoutClass l' a) => l' a -> (l' a -> l a) -> b) -> b + +data (LayoutClass l a) => EL l a = forall l'. (LayoutClass l' a) => EL (l' a) (l' a -> l a) -data EL a = forall l. (LayoutClass l a) => EL (l a) +unEL :: (LayoutClass l a) => EL l a -> (forall l'. (LayoutClass l' a) => l' a -> b) -> b +unEL (EL x _) k = k x -unEL :: EL a -> (forall l. (LayoutClass l a) => l a -> b) -> b -unEL (EL x) k = k x +deEL :: (LayoutClass l a) => EL l a -> l a +deEL (EL x det) = det x -transform' :: (Transformer t a) => t -> EL a -> EL a -transform' t el = el `unEL` \l -> transform t l EL +transform' :: (Transformer t a, LayoutClass l a) => t -> EL l a -> EL l a +transform' t (EL l det) = transform t l (\l' det' -> EL l' (det . det')) -- | Toggle the specified layout transformer. data Toggle a = forall t. (Transformer t a) => Toggle t @@ -117,10 +116,8 @@ data MultiToggleS ts l a = MultiToggleS (l a) (Maybe Int) ts deriving (Read, Show) data MultiToggle ts l a = MultiToggle{ - baseLayout :: l a, - currLayout :: EL a, + currLayout :: EL l a, currIndex :: Maybe Int, - currTrans :: EL a -> EL a, transformers :: ts } @@ -128,27 +125,23 @@ expand :: (LayoutClass l a, HList ts a) => MultiToggleS ts l a -> MultiToggle ts expand (MultiToggleS b i ts) = resolve ts (fromMaybe (-1) i) id (\x mt -> - let g = transform' x in - mt{ - currLayout = g . EL $ baseLayout mt, - currTrans = g - } + let g = transform' x in mt{ currLayout = g $ currLayout mt } ) - (MultiToggle b (EL b) i id ts) + (MultiToggle (EL b id) i ts) -collapse :: MultiToggle ts l a -> MultiToggleS ts l a -collapse mt = MultiToggleS (baseLayout mt) (currIndex mt) (transformers mt) +collapse :: (LayoutClass l a) => MultiToggle ts l a -> MultiToggleS ts l a +collapse mt = MultiToggleS (deEL (currLayout mt)) (currIndex mt) (transformers mt) instance (LayoutClass l a, Read (l a), HList ts a, Read ts) => Read (MultiToggle ts l a) where readsPrec p s = map (first expand) $ readsPrec p s -instance (Show ts, Show (l a)) => Show (MultiToggle ts l a) where +instance (Show ts, Show (l a), LayoutClass l a) => Show (MultiToggle ts l a) where showsPrec p = showsPrec p . collapse -- | Construct a @MultiToggle@ layout from a transformer table and a base -- layout. mkToggle :: (LayoutClass l a) => ts -> l a -> MultiToggle ts l a -mkToggle ts l = MultiToggle l (EL l) Nothing id ts +mkToggle ts l = MultiToggle (EL l id) Nothing ts -- | Construct a @MultiToggle@ layout from a single transformer and a base -- layout. @@ -190,48 +183,26 @@ instance (Transformer a w, HList b w) => HList (HCons a b) w where geq :: (Typeable a, Eq a, Typeable b) => a -> b -> Bool geq a b = Just a == cast b -acceptChange :: (LayoutClass l' a) => MultiToggle ts l a -> ((l' a -> MultiToggle ts l a) -> b -> c) -> X b -> X c -acceptChange mt f = fmap (f (\x -> mt{ currLayout = EL x })) - instance (Typeable a, Show ts, HList ts a, LayoutClass l a) => LayoutClass (MultiToggle ts l) a where description mt = currLayout mt `unEL` \l -> description l - runLayout (Workspace i mt s) r - | isNothing (currIndex mt) = - acceptChange mt (fmap . fmap . \f x -> (f x){ baseLayout = x }) $ runLayout (Workspace i (baseLayout mt) s) r - | otherwise = currLayout mt `unEL` \l -> - acceptChange mt (fmap . fmap) $ runLayout (Workspace i l s) r + runLayout (Workspace i mt s) r = case currLayout mt of + EL l det -> fmap (fmap . fmap $ (\x -> mt { currLayout = EL x det })) $ + runLayout (Workspace i l s) r handleMessage mt m | Just (Toggle t) <- fromMessage m , i@(Just _) <- find (transformers mt) t - = currLayout mt `unEL` \l -> - if i == currIndex mt - then do - handleMessage l (SomeMessage ReleaseResources) + = case currLayout mt of + EL l det -> do + l' <- fromMaybe l `fmap` handleMessage l (SomeMessage ReleaseResources) return . Just $ - mt{ - currLayout = EL $ baseLayout mt, - currIndex = Nothing, - currTrans = id + mt { + currLayout = (if cur then id else transform' t) (EL (det l') id), + currIndex = if cur then Nothing else i } - else do - handleMessage l (SomeMessage ReleaseResources) - let f = transform' t - return . Just $ - mt{ - currLayout = f . EL $ baseLayout mt, - currIndex = i, - currTrans = f - } - | fromMessage m == Just ReleaseResources || - fromMessage m == Just Hide - = currLayout mt `unEL` \l -> acceptChange mt fmap (handleMessage l m) - | otherwise = do - ml <- handleMessage (baseLayout mt) m - case ml of - Nothing -> return Nothing - Just b' -> currLayout mt `unEL` \l -> do - handleMessage l (SomeMessage ReleaseResources) - return . Just $ - mt{ baseLayout = b', currLayout = currTrans mt . EL $ b' } + where cur = (i == currIndex mt) + | otherwise + = case currLayout mt of + EL l det -> fmap (fmap (\x -> mt { currLayout = EL x det })) $ + handleMessage l m diff --git a/XMonad/Layout/MultiToggle/Instances.hs b/XMonad/Layout/MultiToggle/Instances.hs index a409aa8..b8112f1 100644 --- a/XMonad/Layout/MultiToggle/Instances.hs +++ b/XMonad/Layout/MultiToggle/Instances.hs @@ -22,6 +22,7 @@ import XMonad.Layout.MultiToggle import XMonad import XMonad.Layout.NoBorders +import XMonad.Layout.LayoutModifier data StdTransformers = FULL -- ^ switch to Full layout | NBFULL -- ^ switch to Full with no borders @@ -31,8 +32,8 @@ data StdTransformers = FULL -- ^ switch to Full layout deriving (Read, Show, Eq, Typeable) instance Transformer StdTransformers Window where - transform FULL _ k = k Full - transform NBFULL _ k = k (noBorders Full) - transform MIRROR x k = k (Mirror x) - transform NOBORDERS x k = k (noBorders x) - transform SMARTBORDERS x k = k (smartBorders x) + transform FULL x k = k Full (const x) + transform NBFULL x k = k (noBorders Full) (const x) + transform MIRROR x k = k (Mirror x) (\(Mirror x') -> x') + transform NOBORDERS x k = k (noBorders x) (\(ModifiedLayout _ x') -> x') + transform SMARTBORDERS x k = k (smartBorders x) (\(ModifiedLayout _ x') -> x') diff --git a/XMonad/Layout/Reflect.hs b/XMonad/Layout/Reflect.hs index aed67ac..03fd6b6 100644 --- a/XMonad/Layout/Reflect.hs +++ b/XMonad/Layout/Reflect.hs @@ -105,7 +105,7 @@ data REFLECTX = REFLECTX deriving (Read, Show, Eq, Typeable) data REFLECTY = REFLECTY deriving (Read, Show, Eq, Typeable) instance Transformer REFLECTX Window where - transform REFLECTX x k = k (reflectHoriz x) + transform REFLECTX x k = k (reflectHoriz x) (\(ModifiedLayout _ x') -> x') instance Transformer REFLECTY Window where - transform REFLECTY x k = k (reflectVert x)
\ No newline at end of file + transform REFLECTY x k = k (reflectVert x) (\(ModifiedLayout _ x') -> x') |