rename modifyLayout to handleMessage.

This commit is contained in:
David Roundy
2007-09-25 18:29:06 +00:00
parent e062265b38
commit f420ae881d
2 changed files with 17 additions and 17 deletions

View File

@@ -297,7 +297,7 @@ setFocusX w = withWindowSet $ \ws -> do
-- --
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = do w <- (W.workspace . W.current) `fmap` gets windowset sendMessage a = do w <- (W.workspace . W.current) `fmap` gets windowset
ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> whenJust ml' $ \l' ->
do windows $ \ws -> ws { W.current = (W.current ws) do windows $ \ws -> ws { W.current = (W.current ws)
{ W.workspace = (W.workspace $ W.current ws) { W.workspace = (W.workspace $ W.current ws)
@@ -307,7 +307,7 @@ sendMessage a = do w <- (W.workspace . W.current) `fmap` gets windowset
sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X () sendMessageToWorkspaces :: Message a => a -> [WorkspaceId] -> X ()
sendMessageToWorkspaces a l = runOnWorkspaces modw sendMessageToWorkspaces a l = runOnWorkspaces modw
where modw w = if W.tag w `elem` l where modw w = if W.tag w `elem` l
then do ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing then do ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
return $ w { W.layout = maybe (W.layout w) id ml' } return $ w { W.layout = maybe (W.layout w) id ml' }
else return w else return w
@@ -315,7 +315,7 @@ sendMessageToWorkspaces a l = runOnWorkspaces modw
-- This is how we implement the hooks, such as UnDoLayout. -- This is how we implement the hooks, such as UnDoLayout.
broadcastMessage :: Message a => a -> X () broadcastMessage :: Message a => a -> X ()
broadcastMessage a = runOnWorkspaces modw broadcastMessage a = runOnWorkspaces modw
where modw w = do ml' <- modifyLayout (W.layout w) (SomeMessage a) `catchX` return Nothing where modw w = do ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
return $ w { W.layout = maybe (W.layout w) id ml' } return $ w { W.layout = maybe (W.layout w) id ml' }
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X () runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
@@ -352,7 +352,7 @@ instance ReadableSomeLayout a => Layout LayoutSelection a where
doLayout (LayoutSelection []) r s = do (x,_) <- doLayout Full r s doLayout (LayoutSelection []) r s = do (x,_) <- doLayout Full r s
return (x,Nothing) return (x,Nothing)
-- respond to messages only when there's an actual choice: -- respond to messages only when there's an actual choice:
modifyLayout (LayoutSelection (l:ls@(_:_))) m handleMessage (LayoutSelection (l:ls@(_:_))) m
| Just NextLayout <- fromMessage m = switchl rls | Just NextLayout <- fromMessage m = switchl rls
| Just PrevLayout <- fromMessage m = switchl rls' | Just PrevLayout <- fromMessage m = switchl rls'
| Just (JumpToLayout x) <- fromMessage m = switchl (j x) | Just (JumpToLayout x) <- fromMessage m = switchl (j x)
@@ -361,15 +361,15 @@ instance ReadableSomeLayout a => Layout LayoutSelection a where
rls' = reverse . rls . reverse rls' = reverse . rls . reverse
j s zs = case partition (\z -> s == description z) zs of j s zs = case partition (\z -> s == description z) zs of
(xs,ys) -> xs++ys (xs,ys) -> xs++ys
switchl f = do ml' <- modifyLayout l (SomeMessage Hide) switchl f = do ml' <- handleMessage l (SomeMessage Hide)
return $ Just (LayoutSelection $ f $ fromMaybe l ml':ls) return $ Just (LayoutSelection $ f $ fromMaybe l ml':ls)
-- otherwise, or if we don't understand the message, pass it along to the real -- otherwise, or if we don't understand the message, pass it along to the real
-- layout: -- layout:
modifyLayout (LayoutSelection (l:ls)) m handleMessage (LayoutSelection (l:ls)) m
= do ml' <- modifyLayout l m = do ml' <- handleMessage l m
return $ (\l' -> LayoutSelection (l':ls)) `fmap` ml' return $ (\l' -> LayoutSelection (l':ls)) `fmap` ml'
-- Unless there is no layout... -- Unless there is no layout...
modifyLayout (LayoutSelection []) _ = return Nothing handleMessage (LayoutSelection []) _ = return Nothing
-- --
-- Builtin layout algorithms: -- Builtin layout algorithms:
-- --
@@ -399,7 +399,7 @@ instance Layout Tall a where
doLayout (Tall nmaster _ frac) r = doLayout (Tall nmaster _ frac) r =
return . (\x->(x,Nothing)) . return . (\x->(x,Nothing)) .
ap zip (tile frac r nmaster . length) . W.integrate ap zip (tile frac r nmaster . length) . W.integrate
modifyLayout (Tall nmaster delta frac) m = handleMessage (Tall nmaster delta frac) m =
return $ msum [fmap resize (fromMessage m) return $ msum [fmap resize (fromMessage m)
,fmap incmastern (fromMessage m)] ,fmap incmastern (fromMessage m)]
where resize Shrink = Tall nmaster delta (max 0 $ frac-delta) where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)
@@ -417,7 +417,7 @@ data Mirror l a = Mirror (l a) deriving (Show, Read)
instance Layout l a => Layout (Mirror l) a where instance Layout l a => Layout (Mirror l) a where
doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror) doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror)
`fmap` doLayout l (mirrorRect r) s `fmap` doLayout l (mirrorRect r) s
modifyLayout (Mirror l) = fmap (fmap Mirror) . modifyLayout l handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l
description (Mirror l) = "Mirror "++ description l description (Mirror l) = "Mirror "++ description l
-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm. -- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.

View File

@@ -125,9 +125,9 @@ atom_WM_STATE = getAtom "WM_STATE"
-- by 'doLayout', then it is not shown on screen. Windows are restacked -- by 'doLayout', then it is not shown on screen. Windows are restacked
-- according to the order they are returned by 'doLayout'. -- according to the order they are returned by 'doLayout'.
-- --
-- 'modifyLayout' performs message handling for that layout. If -- 'handleMessage' performs message handling for that layout. If
-- 'modifyLayout' returns Nothing, then the layout did not respond to -- 'handleMessage' returns Nothing, then the layout did not respond to
-- that message and the screen is not refreshed. Otherwise, 'modifyLayout' -- that message and the screen is not refreshed. Otherwise, 'handleMessage'
-- returns an updated 'Layout' and the screen is refreshed. -- returns an updated 'Layout' and the screen is refreshed.
-- --
data SomeLayout a = forall l. Layout l a => SomeLayout (l a) data SomeLayout a = forall l. Layout l a => SomeLayout (l a)
@@ -138,7 +138,7 @@ instance ReadableSomeLayout a => Read (SomeLayout a) where
readsPrec _ = readLayout defaults readsPrec _ = readLayout defaults
instance ReadableSomeLayout a => Layout SomeLayout a where instance ReadableSomeLayout a => Layout SomeLayout a where
doLayout (SomeLayout l) r s = fmap (fmap $ fmap SomeLayout) $ doLayout l r s doLayout (SomeLayout l) r s = fmap (fmap $ fmap SomeLayout) $ doLayout l r s
modifyLayout (SomeLayout l) = fmap (fmap SomeLayout) . modifyLayout l handleMessage (SomeLayout l) = fmap (fmap SomeLayout) . handleMessage l
instance Show (SomeLayout a) where instance Show (SomeLayout a) where
show (SomeLayout l) = show l show (SomeLayout l) = show l
@@ -155,8 +155,8 @@ class (Show (layout a), Read (layout a)) => Layout layout a where
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)] pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
pureLayout _ r s = [(focus s, r)] pureLayout _ r s = [(focus s, r)]
modifyLayout :: layout a -> SomeMessage -> X (Maybe (layout a)) handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
modifyLayout _ _ = return Nothing handleMessage _ _ = return Nothing
description :: layout a -> String description :: layout a -> String
description = show description = show
@@ -164,7 +164,7 @@ runLayout :: Layout l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle
runLayout l r = maybe (return ([], Nothing)) (doLayout l r) runLayout l r = maybe (return ([], Nothing)) (doLayout l r)
-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/, -- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/,
-- Simon Marlow, 2006. Use extensible messages to the modifyLayout handler. -- Simon Marlow, 2006. Use extensible messages to the handleMessage handler.
-- --
-- User-extensible messages must be a member of this class. -- User-extensible messages must be a member of this class.
-- --