diff options
author | l.mai <l.mai@web.de> | 2007-10-08 00:41:16 +0200 |
---|---|---|
committer | l.mai <l.mai@web.de> | 2007-10-08 00:41:16 +0200 |
commit | 6d85e32796d53746a023efcec23ff3735d3d8d7e (patch) | |
tree | ec75c44cb62d712d4e80881ea2ce274ba15fac34 | |
parent | e6c32f5a4cfc39059e25d0fc39fbc3eccca56969 (diff) | |
download | XMonadContrib-6d85e32796d53746a023efcec23ff3735d3d8d7e.tar.gz XMonadContrib-6d85e32796d53746a023efcec23ff3735d3d8d7e.tar.xz XMonadContrib-6d85e32796d53746a023efcec23ff3735d3d8d7e.zip |
fix SwitchTrans some more
darcs-hash:20071007224116-42ea9-bdc93da2c7993d5b10ae3d27a0dcb4af81f2bf1e.gz
Diffstat (limited to '')
-rw-r--r-- | SwitchTrans.hs | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/SwitchTrans.hs b/SwitchTrans.hs index 8328d65..c4be6cd 100644 --- a/SwitchTrans.hs +++ b/SwitchTrans.hs @@ -110,36 +110,39 @@ instance Read (SwitchTrans a) where unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r unLayout (Layout l) k = k l +acceptChange :: (LayoutClass l a) => SwitchTrans a -> ((l a -> SwitchTrans a) -> b -> c) -> X b -> X c +acceptChange st f action = + -- seriously, Dave, you need to stop this + fmap (f (\l -> st{ currLayout = Layout l})) action + instance LayoutClass SwitchTrans a where description _ = "SwitchTrans" - doLayout st r s = currLayout st `unLayout` \l -> do - (x, y) <- doLayout l r s - case y of - Nothing -> return (x, Nothing) - -- ok, Dave; but just this one time - Just l' -> return (x, Just $ st{ currLayout = Layout l' }) + doLayout st r s = currLayout st `unLayout` \l -> + acceptChange st (fmap . fmap) (doLayout l r s) pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s handleMessage st m | Just (Disable tag) <- fromMessage m , M.member tag (filters st) - = provided (currTag st == Just tag) $ disable + = provided (currTag st == Just tag) $ disable | Just (Enable tag) <- fromMessage m , Just alt <- M.lookup tag (filters st) - = provided (currTag st /= Just tag) $ enable tag alt + = provided (currTag st /= Just tag) $ enable tag alt | Just (Toggle tag) <- fromMessage m , Just alt <- M.lookup tag (filters st) - = + = if (currTag st == Just tag) then disable else enable tag alt | Just ReleaseResources <- fromMessage m - = currLayout st `unLayout` \cl -> do - handleMessage cl m - return Nothing + = currLayout st `unLayout` \cl -> + acceptChange st fmap (handleMessage cl m) + | Just Hide <- fromMessage m + = currLayout st `unLayout` \cl -> + acceptChange st fmap (handleMessage cl m) | otherwise = base st `unLayout` \b -> do x <- handleMessage b m case x of |