mirror of
https://github.com/xmonad/xmonad.git
synced 2025-08-17 12:53:48 -07:00
rename modifyLayout to handleMessage.
This commit is contained in:
@@ -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.
|
||||||
|
14
XMonad.hs
14
XMonad.hs
@@ -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.
|
||||||
--
|
--
|
||||||
|
Reference in New Issue
Block a user