diff options
| -rw-r--r-- | XMonad/Layout/LayoutModifier.hs | 24 |
1 files changed, 21 insertions, 3 deletions
diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index a55444f..a1db7a3 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -29,6 +29,8 @@ module XMonad.Layout.LayoutModifier ( LayoutModifier(..), ModifiedLayout(..) ) where +import Control.Monad + import XMonad import XMonad.StackSet ( Stack, Workspace (..) ) @@ -106,6 +108,22 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where -> X ([(a, Rectangle)], Maybe (l a)) modifyLayout _ w r = runLayout w r + -- | Similar to 'modifyLayout', but this function also allows you + -- update the state of your layout modifier(the second value in the + -- outer tuple). + -- + -- If both 'modifyLayoutWithUpdate' and 'redoLayout' return a + -- modified state of the layout modifier, 'redoLayout' takes + -- precedence. If this function returns a modified state, this + -- state will internally be used in the subsequent call to + -- 'redoLayout' as well. + modifyLayoutWithUpdate :: (LayoutClass l a) => + m a + -> Workspace WorkspaceId (l a) a + -> Rectangle + -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a)) + modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r + -- | 'handleMess' allows you to spy on messages to the underlying -- layout, in order to have an effect in the X monad, or alter -- the layout modifier state in some way (by returning @Just @@ -234,9 +252,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where -- semantics of a 'LayoutModifier' applied to an underlying layout. instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where runLayout (Workspace i (ModifiedLayout m l) ms) r = - do (ws, ml') <- modifyLayout m (Workspace i l ms) r - (ws', mm') <- redoLayout m r ms ws - let ml'' = case mm' of + do ((ws, ml'),mm') <- modifyLayoutWithUpdate m (Workspace i l ms) r + (ws', mm'') <- redoLayout (maybe m id mm') r ms ws + let ml'' = case mm'' `mplus` mm' of Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml' Nothing -> ModifiedLayout m `fmap` ml' return (ws', ml'') |