twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-01 20:51:52 -07:00
Code Issues Packages Projects Releases Wiki Activity

fix SwitchTrans some more

Browse Source
This commit is contained in:
l.mai
2007-10-07 22:41:16 +00:00
parent 11687d63fb
commit 6120380809
1 changed files with 15 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

27
SwitchTrans.hs
View File

@@ -110,36 +110,39 @@ instance Read (SwitchTrans a) where
unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r unLayout :: Layout a -> (forall l. (LayoutClass l a) => l a -> r) -> r
unLayout (Layout l) k = k l 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 instance LayoutClass SwitchTrans a where
description _ = "SwitchTrans" description _ = "SwitchTrans"
doLayout st r s = currLayout st `unLayout` \l -> do doLayout st r s = currLayout st `unLayout` \l ->
(x, y) <- doLayout l r s acceptChange st (fmap . fmap) (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' })
pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s
handleMessage st m handleMessage st m
| Just (Disable tag) <- fromMessage m | Just (Disable tag) <- fromMessage m
, M.member tag (filters st) , M.member tag (filters st)
= provided (currTag st == Just tag) $ disable = provided (currTag st == Just tag) $ disable
| Just (Enable tag) <- fromMessage m | Just (Enable tag) <- fromMessage m
, Just alt <- M.lookup tag (filters st) , 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 (Toggle tag) <- fromMessage m
, Just alt <- M.lookup tag (filters st) , Just alt <- M.lookup tag (filters st)
= =
if (currTag st == Just tag) then if (currTag st == Just tag) then
disable disable
else else
enable tag alt enable tag alt
| Just ReleaseResources <- fromMessage m | Just ReleaseResources <- fromMessage m
= currLayout st `unLayout` \cl -> do = currLayout st `unLayout` \cl ->
handleMessage cl m acceptChange st fmap (handleMessage cl m)
return Nothing | Just Hide <- fromMessage m
= currLayout st `unLayout` \cl ->
acceptChange st fmap (handleMessage cl m)
| otherwise = base st `unLayout` \b -> do | otherwise = base st `unLayout` \b -> do
x <- handleMessage b m x <- handleMessage b m
case x of case x of