mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 04:31:52 -07:00
allow layout modifiers to modify a Message in transit.
This is a helpful feature (for, e.g. WindowNavigation) that allows modifiers (if they so choose... the old API remains supported) to easily send a single Message to the modified layout in response to a Message.
This commit is contained in:
@@ -34,6 +34,9 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
|
||||
| Just ReleaseResources <- fromMessage mess = doUnhook
|
||||
| otherwise = return Nothing
|
||||
where doUnhook = do unhook m; return Nothing
|
||||
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
|
||||
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
|
||||
return (Left `fmap` mm')
|
||||
redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
|
||||
-> X ([(a, Rectangle)], Maybe (m a))
|
||||
redoLayout m _ _ wrs = do hook m; return (wrs, Nothing)
|
||||
@@ -53,11 +56,13 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
|
||||
Nothing -> ModifiedLayout m `fmap` ml'
|
||||
return (ws', ml'')
|
||||
handleMessage (ModifiedLayout m l) mess =
|
||||
do ml' <- handleMessage l mess
|
||||
mm' <- handleMess m mess
|
||||
do mm' <- handleMessOrMaybeModifyIt m mess
|
||||
ml' <- case mm' of
|
||||
Just (Right mess') -> handleMessage l mess'
|
||||
_ -> handleMessage l mess
|
||||
return $ case mm' of
|
||||
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
||||
Nothing -> (ModifiedLayout m) `fmap` ml'
|
||||
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
||||
_ -> (ModifiedLayout m) `fmap` ml'
|
||||
description (ModifiedLayout m l) = modifierDescription m <> description l
|
||||
where "" <> x = x
|
||||
x <> y = x ++ " " ++ y
|
||||
|
Reference in New Issue
Block a user