From fdb123ffb0c3956f8bd4d982546e885bb89b3079 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Sat, 20 Oct 2007 21:15:42 +0200 Subject: 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. darcs-hash:20071020191542-72aca-fd6b8f2edb91519b4e475319c2bc8c3d4b77136d.gz --- LayoutModifier.hs | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) (limited to 'LayoutModifier.hs') diff --git a/LayoutModifier.hs b/LayoutModifier.hs index 88eed93..3c30ec8 100644 --- a/LayoutModifier.hs +++ b/LayoutModifier.hs @@ -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 -- cgit v1.2.3