twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

simplify NewSelect code.

Browse Source
This commit is contained in:
David Roundy 2007-11-14 22:35:38 +00:00
parent 0292c8e4f5
commit f978d76172
1 changed files with 41 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
XMonad/Layout/LayoutCombinators.hs
View File

@ -23,7 +23,7 @@ module XMonad.Layout.LayoutCombinators (
) where ) where
import Data.Maybe ( isJust ) import Data.Maybe ( isJust, isNothing )
import XMonad import XMonad
import XMonad.Layouts ( Tall(..), Mirror(..), ChangeLayout(NextLayout) ) import XMonad.Layouts ( Tall(..), Mirror(..), ChangeLayout(NextLayout) )
@ -75,59 +75,26 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
description (NewSelect True l1 _) = description l1 description (NewSelect True l1 _) = description l1
description (NewSelect False _ l2) = description l2 description (NewSelect False _ l2) = description l2
handleMessage (NewSelect False l1 l2) m handleMessage l@(NewSelect False _ _) m
| Just Wrap <- fromMessage m = | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m
do ml2' <- handleMessage l2 (SomeMessage Hide) handleMessage l@(NewSelect amfirst _ _) m
ml1' <- handleMessage l1 m
return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2')
handleMessage (NewSelect True l1 l2) m
| Just NextLayoutNoWrap <- fromMessage m = | Just NextLayoutNoWrap <- fromMessage m =
do ml1' <- handleMessage l1 m if amfirst then when' isNothing (passOnM m l) $
case ml1' of fmap Just $ swap l >>= passOn (SomeMessage Wrap)
Just l1' -> return $ Just (NewSelect True l1' l2) else passOnM m l
Nothing -> do ml1'' <- handleMessage l1 (SomeMessage Hide) handleMessage l m
ml2' <- handleMessage l2 (SomeMessage Wrap) | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
return $ Just $ NewSelect False (maybe l1 id ml1'') (maybe l2 id ml2') fmap Just $ swap l >>= passOn (SomeMessage Wrap)
handleMessage l@(NewSelect True _ _) m handleMessage l@(NewSelect True _ l2) m
| Just NextLayout <- fromMessage m = handleMessage l (SomeMessage NextLayoutNoWrap) | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l
handleMessage l@(NewSelect False l1 l2) m handleMessage l@(NewSelect False l1 _) m
| Just NextLayout <- fromMessage m = | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l
do ml' <- handleMessage l (SomeMessage NextLayoutNoWrap) handleMessage l m
case ml' of | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
Just l' -> return $ Just l' do ml' <- passOnM m $ sw l
Nothing -> do ml2' <- handleMessage l2 (SomeMessage Hide) case ml' of
ml1' <- handleMessage l1 (SomeMessage Wrap) Nothing -> return Nothing
return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') Just l' -> Just `fmap` swap (sw l')
handleMessage (NewSelect True l1 l2) m
| Just (JumpToLayout d) <- fromMessage m,
d == description l2 = do ml1' <- handleMessage l1 (SomeMessage Hide)
return $ Just $ NewSelect False (maybe l1 id ml1') l2
handleMessage (NewSelect True l1 l2) m
| Just (JumpToLayout _) <- fromMessage m
= do ml1' <- handleMessage l1 m
case ml1' of
Just l1' -> return $ Just $ NewSelect True l1' l2
Nothing ->
do ml2' <- handleMessage l2 m
case ml2' of
Nothing -> return Nothing
Just l2' -> do ml1'' <- handleMessage l1 (SomeMessage Hide)
return $ Just $ NewSelect False (maybe l1 id ml1'') l2'
handleMessage (NewSelect False l1 l2) m
| Just (JumpToLayout d) <- fromMessage m,
d == description l1 = do ml2' <- handleMessage l2 (SomeMessage Hide)
return $ Just $ NewSelect True l1 (maybe l2 id ml2')
handleMessage (NewSelect False l1 l2) m
| Just (JumpToLayout _) <- fromMessage m
= do ml2' <- handleMessage l2 m
case ml2' of
Just l2' -> return $ Just $ NewSelect False l1 l2'
Nothing ->
do ml1' <- handleMessage l1 m
case ml1' of
Nothing -> return Nothing
Just l1' -> do ml2'' <- handleMessage l2 (SomeMessage Hide)
return $ Just $ NewSelect True l1' (maybe l2 id ml2'')
handleMessage (NewSelect b l1 l2) m handleMessage (NewSelect b l1 l2) m
| Just ReleaseResources <- fromMessage m = | Just ReleaseResources <- fromMessage m =
do ml1' <- handleMessage l1 m do ml1' <- handleMessage l1 m
@ -135,9 +102,24 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
return $ if isJust ml1' || isJust ml2' return $ if isJust ml1' || isJust ml2'
then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2') then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2')
else Nothing else Nothing
handleMessage (NewSelect True l1 l2) m = handleMessage l m = passOnM m l
do ml1' <- handleMessage l1 m
return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
handleMessage (NewSelect False l1 l2) m = swap l = sw `fmap` passOn (SomeMessage Hide) l
do ml2' <- handleMessage l2 m
return $ (\l2' -> NewSelect False l1 l2') `fmap` ml2' sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
sw (NewSelect b lt lf) = NewSelect (not b) lt lf
passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
passOn m l = maybe l id `fmap` passOnM m l
passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'
passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'
when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
when' f a b = do a1 <- a; if f a1 then b else return a1