Merge emptyLayoutMod into redoLayout

This removes the emptyLayoutMod method from the LayoutModifier class, and
change the Stack parameter to redoLayout to a Maybe Stack one. It also changes
all affected code. This should should be a refactoring without any change in
program behaviour.
This commit is contained in:
Joachim Breitner 2008-10-05 19:02:20 +00:00
parent 2102a565fd
commit 2480ba1f02
9 changed files with 29 additions and 56 deletions

View File

@ -65,7 +65,8 @@ instance Show (MouseResize a) where show _ = ""
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
instance LayoutModifier MouseResize Window where
redoLayout (MR st) _ s wrs
redoLayout _ _ Nothing wrs = return (wrs, Nothing)
redoLayout (MR st) _ (Just s) wrs
| [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst)
| otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
where

View File

@ -201,7 +201,12 @@ instance Eq a => DecorationStyle DefaultDecoration a
-- 'handleEvent', which will call the appropriate 'DecorationStyle'
-- methods to perform its tasks.
instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where
redoLayout (Decoration st sh t ds) sc stack wrs
redoLayout (Decoration (I (Just s)) sh t ds) _ Nothing _ = do
releaseResources s
return ([], Just $ Decoration (I Nothing) sh t ds)
redoLayout _ _ Nothing _ = return ([], Nothing)
redoLayout (Decoration st sh t ds) sc (Just stack) wrs
| I Nothing <- st = initState t ds sc stack wrs >>= processState
| I (Just s) <- st = do let dwrs = decos s
(d,a) = curry diff (get_ws dwrs) ws
@ -264,11 +269,6 @@ instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration d
return $ Just $ Decoration (I Nothing) sh t ds
handleMess _ _ = return Nothing
emptyLayoutMod (Decoration (I (Just s)) sh t ds) _ _ = do
releaseResources s
return ([], Just $ Decoration (I Nothing) sh t ds)
emptyLayoutMod _ _ _ = return ([], Nothing)
modifierDescription (Decoration _ _ _ ds) = describeDeco ds
-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'

View File

@ -46,7 +46,8 @@ data LayoutHints a = LayoutHints deriving (Read, Show)
instance LayoutModifier LayoutHints Window where
modifierDescription _ = "Hinted"
redoLayout _ _ s xs = do
redoLayout _ _ Nothing xs = return (xs, Nothing)
redoLayout _ _ (Just s) xs = do
xs' <- mapM applyHint xs
return (xs', Nothing)
where

View File

@ -164,18 +164,17 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
-- consider implementing 'hook' and 'pureModifier' instead of
-- 'redoLayout'.
--
-- If you also need to perform some action when 'runLayout' is
-- called on an empty workspace, see 'emptyLayoutMod'.
-- On empty workspaces, the Stack is Nothing.
--
-- The default implementation of 'redoLayout' calls 'hook' and
-- then 'pureModifier'.
redoLayout :: m a -- ^ the layout modifier
-> Rectangle -- ^ screen rectangle
-> Stack a -- ^ current window stack
redoLayout :: m a -- ^ the layout modifier
-> Rectangle -- ^ screen rectangle
-> Maybe (Stack a) -- ^ current window stack
-> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned
-- by the underlying layout
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs
redoLayout m r ms wrs = do hook m; return $ pureModifier m r ms wrs
-- | 'pureModifier' allows you to intercept a call to 'runLayout'
-- /after/ it is called on the underlying layout, in order to
@ -184,33 +183,14 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
--
-- The default implementation of 'pureModifier' returns the
-- window rectangles unmodified.
pureModifier :: m a -- ^ the layout modifier
-> Rectangle -- ^ screen rectangle
-> Stack a -- ^ current window stack
pureModifier :: m a -- ^ the layout modifier
-> Rectangle -- ^ screen rectangle
-> Maybe (Stack a) -- ^ current window stack
-> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned
-- by the underlying layout
-> ([(a, Rectangle)], Maybe (m a))
pureModifier _ _ _ wrs = (wrs, Nothing)
-- | 'emptyLayoutMod' allows you to intercept a call to
-- 'runLayout' on an empty workspace, /after/ it is called on
-- the underlying layout, in order to perform some effect in the
-- X monad, possibly return a new layout modifier, and\/or
-- modify the results of 'runLayout' before returning them.
--
-- If you don't need access to the X monad, then tough luck.
-- There isn't a pure version of 'emptyLayoutMod'.
--
-- The default implementation of 'emptyLayoutMod' ignores its
-- arguments and returns an empty list of window\/rectangle
-- pairings.
--
-- /NOTE/: 'emptyLayoutMod' will likely be combined with
-- 'redoLayout' soon!
emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
emptyLayoutMod _ _ _ = return ([], Nothing)
-- | 'hook' is called by the default implementation of
-- 'redoLayout', and as such represents an X action which is to
-- be run each time 'runLayout' is called on the underlying
@ -256,9 +236,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
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') <- case ms of
Just s -> redoLayout m r s ws
Nothing -> emptyLayoutMod m r ws
(ws', mm') <- redoLayout m r ms ws
let ml'' = case mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml'

View File

@ -114,10 +114,9 @@ data Toggle = On | Off deriving (Read, Show)
data MagnifyMaster = All | NoMaster deriving (Read, Show)
instance LayoutModifier Magnifier Window where
redoLayout (Mag z On All ) = applyMagnifier z
redoLayout (Mag z On NoMaster) = unlessMaster $ applyMagnifier z
redoLayout _ = nothing
where nothing _ _ wrs = return (wrs, Nothing)
redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs
redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs
redoLayout _ _ _ wrs = return (wrs, Nothing)
handleMess (Mag z On t) m
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t)

View File

@ -75,15 +75,10 @@ data SmartBorder a = SmartBorder [a] deriving (Read, Show)
instance LayoutModifier SmartBorder Window where
unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
redoLayout sb _ st wrs = genericLayoutMod sb (W.integrate st) wrs
emptyLayoutMod sb _ wrs = genericLayoutMod sb [] wrs
genericLayoutMod :: (SmartBorder Window) -> [Window] -> [(Window, b)] ->
X ([(Window, b)], Maybe (SmartBorder Window))
genericLayoutMod (SmartBorder s) managedwindows wrs = do
redoLayout (SmartBorder s) _ mst wrs = do
wset <- gets windowset
let screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset
let managedwindows = W.integrate' mst
screens = filter (nonzerorect . screenRect . W.screenDetail) . W.screens $ wset
ws = tiled ++ floating
tiled = case filter (`elem` managedwindows) $ map fst wrs of
[w] | singleton screens -> [w]

View File

@ -70,8 +70,6 @@ defaultSWNConfig =
instance LayoutModifier ShowWName a where
redoLayout sn r _ wrs = doShow sn r wrs
emptyLayoutMod sn r wrs = doShow sn r wrs
handleMess (SWN _ c (Just (i,w))) m
| Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
| Just Hide <- fromMessage m = do deleteWindow w

View File

@ -109,9 +109,9 @@ type ArrangeAll = Bool
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
pureModifier (WA True b []) _ _ wrs = arrangeWindows b wrs
pureModifier (WA True b []) _ (Just _) wrs = arrangeWindows b wrs
pureModifier (WA True b awrs) _ (S.Stack w _ _) wrs = curry process wrs awrs
pureModifier (WA True b awrs) _ (Just (S.Stack w _ _)) wrs = curry process wrs awrs
where
wins = map fst *** map awrWin
update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)

View File

@ -106,7 +106,7 @@ configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout W
configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
instance LayoutModifier WindowNavigation Window where
redoLayout (WindowNavigation conf (I state)) rscr s origwrs =
redoLayout (WindowNavigation conf (I state)) rscr (Just s) origwrs =
do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask
[uc,dc,lc,rc] <-
case brightness conf of
@ -136,6 +136,7 @@ instance LayoutModifier WindowNavigation Window where
mapM_ (sc nbc) (wothers \\ map fst wnavigable)
mapM_ (\(win,c) -> sc c win) wnavigablec
return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
redoLayout _ _ _ origwrs = return (origwrs, Nothing)
handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
| Just (Go d) <- fromMessage m =