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

update LayoutHelpers to work with new Layout class.

Browse Source
This commit is contained in:
David Roundy
2007-09-23 11:49:29 +00:00
parent 4c841078b3
commit dcaae4f01b
1 changed files with 24 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
LayoutHelpers.hs
View File

@@ -1,3 +1,4 @@
{-# OPTIONS -fallow-undecidable-instances #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.LayoutHelpers
@@ -14,49 +15,35 @@
module XMonadContrib.LayoutHelpers (
-- * Usage
-- $usage
DoLayout, ModDo, ModMod, ModLay,
layoutModify,
l2lModDo, idModify,
idModDo, idModMod,
LayoutModifier(..)
) where
import Control.Monad ( mplus )
import Graphics.X11.Xlib ( Rectangle )
import XMonad
import StackSet ( Stack, integrate )
import StackSet ( Stack )
-- $usage
-- Use LayoutHelpers to help write easy Layouts.
type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
class (Show (m l a), Read (m l a), Layout l a) => LayoutModifier m l a where
extractLayout :: m l a -> l a
wrapLayout :: m l a -> l a -> m l a
modifyModify :: m l a -> SomeMessage -> X (Maybe (l a -> m l a))
modifyModify _ _ = return Nothing
redoLayout :: m l a -> Rectangle -> Stack a -> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (l a -> m l a))
redoLayout _ _ _ wrs = return (wrs, Nothing)
type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
type ModMod a = SomeMessage -> X (Maybe (ModLay a))
type ModLay a = Layout a -> Layout a
layoutModify :: ModDo a -> ModMod a -> ModLay a
layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
where dl r s = do (ws, ml') <- doLayout l r s
(ws', mmod') <- fdo r s ws
let ml'' = case mmod' of
Just mod' -> Just $ mod' $ maybe l id ml'
Nothing -> layoutModify fdo fmod `fmap` ml'
return (ws', ml'')
modl m = do ml' <- modifyLayout l m
mmod' <- fmod m
return $ case mmod' of
Just mod' -> Just $ mod' $ maybe l id ml'
Nothing -> layoutModify fdo fmod `fmap` ml'
l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
l2lModDo dl r s = return (dl r $ integrate s, Nothing)
idModDo :: ModDo a
idModDo _ _ wrs = return (wrs, Nothing)
idModify :: ModifyLayout a
idModify _ = return Nothing
idModMod :: ModMod a
idModMod _ = return Nothing
instance LayoutModifier m l a => Layout (m l) a where
doLayout m r s = do (ws, ml') <- doLayout (extractLayout m) r s
(ws', mmod') <- redoLayout m r s ws
let ml'' = case mmod' of
Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
Nothing -> wrapLayout m `fmap` ml'
return (ws', ml'')
modifyLayout m mess = do ml' <- modifyLayout (extractLayout m) mess
mmod' <- modifyModify m mess
return $ case mmod' of
Just mod' -> Just $ mod' $ maybe (extractLayout m) id ml'
Nothing -> wrapLayout m `fmap` ml'