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

add/reformat (commented out) tracing code to SwitchTrans

Browse Source
This commit is contained in:
l.mai 2007-10-11 02:21:39 +00:00
parent 183b6fb563
commit 39b30296c5
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
SwitchTrans.hs
View File

@ -81,7 +81,7 @@ import Operations
import qualified Data.Map as M import qualified Data.Map as M
import Data.Map (Map) import Data.Map (Map)
-- import System.IO --import System.IO
-- | Toggle the specified layout transformer. -- | Toggle the specified layout transformer.
@ -119,8 +119,11 @@ acceptChange st f action =
instance LayoutClass SwitchTrans a where instance LayoutClass SwitchTrans a where
description _ = "SwitchTrans" description _ = "SwitchTrans"
doLayout st r s = currLayout st `unLayout` \l -> doLayout st r s = currLayout st `unLayout` \l -> do
acceptChange st (fmap . fmap) (doLayout l r s) --io $ hPutStrLn stderr $ "[ST]{ " ++ show st
x{- @(_, w) -} <- acceptChange st (fmap . fmap) (doLayout l r s)
--io $ hPutStrLn stderr $ "[ST]} " ++ show w
return x
pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s pureLayout st r s = currLayout st `unLayout` \l -> pureLayout l r s
@ -139,11 +142,15 @@ instance LayoutClass SwitchTrans a where
else else
enable tag alt enable tag alt
| Just ReleaseResources <- fromMessage m | Just ReleaseResources <- fromMessage m
= currLayout st `unLayout` \cl -> = currLayout st `unLayout` \cl -> do
--io $ hPutStrLn stderr $ "[ST]~ " ++ show st
acceptChange st fmap (handleMessage cl m) acceptChange st fmap (handleMessage cl m)
| Just Hide <- fromMessage m | Just Hide <- fromMessage m
= currLayout st `unLayout` \cl -> = currLayout st `unLayout` \cl -> do
acceptChange st fmap (handleMessage cl m) --io $ hPutStrLn stderr $ "[ST]< " ++ show st
x <- acceptChange st fmap (handleMessage cl m)
--io $ hPutStrLn stderr $ "[ST]> " ++ show x
return x
| 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
@ -154,14 +161,14 @@ instance LayoutClass SwitchTrans a where
return . Just $ st{ base = b'', currLayout = currFilt st b'' } return . Just $ st{ base = b'', currLayout = currFilt st b'' }
where where
enable tag alt = currLayout st `unLayout` \cl -> do enable tag alt = currLayout st `unLayout` \cl -> do
-- io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st)) --io $ hPutStrLn stderr $ "[ST]+ " ++ show cl ++ " -> " ++ show (alt (base st))
handleMessage cl (SomeMessage ReleaseResources) handleMessage cl (SomeMessage ReleaseResources)
return . Just $ st{ return . Just $ st{
currTag = Just tag, currTag = Just tag,
currFilt = alt, currFilt = alt,
currLayout = alt (base st) } currLayout = alt (base st) }
disable = currLayout st `unLayout` \cl -> do disable = currLayout st `unLayout` \cl -> do
-- io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st) --io $ hPutStrLn stderr $ "[ST]- " ++ show cl ++ " -> " ++ show (base st)
handleMessage cl (SomeMessage ReleaseResources) handleMessage cl (SomeMessage ReleaseResources)
return . Just $ st{ return . Just $ st{
currTag = Nothing, currTag = Nothing,