mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
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:
parent
2102a565fd
commit
2480ba1f02
@ -65,7 +65,8 @@ instance Show (MouseResize a) where show _ = ""
|
|||||||
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
|
instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
|
||||||
|
|
||||||
instance LayoutModifier MouseResize Window where
|
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)
|
| [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst)
|
||||||
| otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
|
| otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
|
||||||
where
|
where
|
||||||
|
@ -201,7 +201,12 @@ instance Eq a => DecorationStyle DefaultDecoration a
|
|||||||
-- 'handleEvent', which will call the appropriate 'DecorationStyle'
|
-- 'handleEvent', which will call the appropriate 'DecorationStyle'
|
||||||
-- methods to perform its tasks.
|
-- methods to perform its tasks.
|
||||||
instance (DecorationStyle ds Window, Shrinker s) => LayoutModifier (Decoration ds s) Window where
|
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 Nothing <- st = initState t ds sc stack wrs >>= processState
|
||||||
| I (Just s) <- st = do let dwrs = decos s
|
| I (Just s) <- st = do let dwrs = decos s
|
||||||
(d,a) = curry diff (get_ws dwrs) ws
|
(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
|
return $ Just $ Decoration (I Nothing) sh t ds
|
||||||
handleMess _ _ = return Nothing
|
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
|
modifierDescription (Decoration _ _ _ ds) = describeDeco ds
|
||||||
|
|
||||||
-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'
|
-- | By default 'Decoration' handles 'PropertyEvent' and 'ExposeEvent'
|
||||||
|
@ -46,7 +46,8 @@ data LayoutHints a = LayoutHints deriving (Read, Show)
|
|||||||
|
|
||||||
instance LayoutModifier LayoutHints Window where
|
instance LayoutModifier LayoutHints Window where
|
||||||
modifierDescription _ = "Hinted"
|
modifierDescription _ = "Hinted"
|
||||||
redoLayout _ _ s xs = do
|
redoLayout _ _ Nothing xs = return (xs, Nothing)
|
||||||
|
redoLayout _ _ (Just s) xs = do
|
||||||
xs' <- mapM applyHint xs
|
xs' <- mapM applyHint xs
|
||||||
return (xs', Nothing)
|
return (xs', Nothing)
|
||||||
where
|
where
|
||||||
|
@ -164,18 +164,17 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
|
|||||||
-- consider implementing 'hook' and 'pureModifier' instead of
|
-- consider implementing 'hook' and 'pureModifier' instead of
|
||||||
-- 'redoLayout'.
|
-- 'redoLayout'.
|
||||||
--
|
--
|
||||||
-- If you also need to perform some action when 'runLayout' is
|
-- On empty workspaces, the Stack is Nothing.
|
||||||
-- called on an empty workspace, see 'emptyLayoutMod'.
|
|
||||||
--
|
--
|
||||||
-- The default implementation of 'redoLayout' calls 'hook' and
|
-- The default implementation of 'redoLayout' calls 'hook' and
|
||||||
-- then 'pureModifier'.
|
-- then 'pureModifier'.
|
||||||
redoLayout :: m a -- ^ the layout modifier
|
redoLayout :: m a -- ^ the layout modifier
|
||||||
-> Rectangle -- ^ screen rectangle
|
-> Rectangle -- ^ screen rectangle
|
||||||
-> Stack a -- ^ current window stack
|
-> Maybe (Stack a) -- ^ current window stack
|
||||||
-> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned
|
-> [(a, Rectangle)] -- ^ (window,rectangle) pairs returned
|
||||||
-- by the underlying layout
|
-- by the underlying layout
|
||||||
-> X ([(a, Rectangle)], Maybe (m a))
|
-> 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'
|
-- | 'pureModifier' allows you to intercept a call to 'runLayout'
|
||||||
-- /after/ it is called on the underlying layout, in order to
|
-- /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
|
-- The default implementation of 'pureModifier' returns the
|
||||||
-- window rectangles unmodified.
|
-- window rectangles unmodified.
|
||||||
pureModifier :: m a -- ^ the layout modifier
|
pureModifier :: m a -- ^ the layout modifier
|
||||||
-> Rectangle -- ^ screen rectangle
|
-> Rectangle -- ^ screen rectangle
|
||||||
-> Stack a -- ^ current window stack
|
-> Maybe (Stack a) -- ^ current window stack
|
||||||
-> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned
|
-> [(a, Rectangle)] -- ^ (window, rectangle) pairs returned
|
||||||
-- by the underlying layout
|
-- by the underlying layout
|
||||||
-> ([(a, Rectangle)], Maybe (m a))
|
-> ([(a, Rectangle)], Maybe (m a))
|
||||||
pureModifier _ _ _ wrs = (wrs, Nothing)
|
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
|
-- | 'hook' is called by the default implementation of
|
||||||
-- 'redoLayout', and as such represents an X action which is to
|
-- 'redoLayout', and as such represents an X action which is to
|
||||||
-- be run each time 'runLayout' is called on the underlying
|
-- 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
|
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
|
||||||
runLayout (Workspace i (ModifiedLayout m l) ms) r =
|
runLayout (Workspace i (ModifiedLayout m l) ms) r =
|
||||||
do (ws, ml') <- modifyLayout m (Workspace i l ms) r
|
do (ws, ml') <- modifyLayout m (Workspace i l ms) r
|
||||||
(ws', mm') <- case ms of
|
(ws', mm') <- redoLayout m r ms ws
|
||||||
Just s -> redoLayout m r s ws
|
|
||||||
Nothing -> emptyLayoutMod m r ws
|
|
||||||
let ml'' = case mm' of
|
let ml'' = case mm' of
|
||||||
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
|
||||||
Nothing -> ModifiedLayout m `fmap` ml'
|
Nothing -> ModifiedLayout m `fmap` ml'
|
||||||
|
@ -114,10 +114,9 @@ data Toggle = On | Off deriving (Read, Show)
|
|||||||
data MagnifyMaster = All | NoMaster deriving (Read, Show)
|
data MagnifyMaster = All | NoMaster deriving (Read, Show)
|
||||||
|
|
||||||
instance LayoutModifier Magnifier Window where
|
instance LayoutModifier Magnifier Window where
|
||||||
redoLayout (Mag z On All ) = applyMagnifier z
|
redoLayout (Mag z On All ) r (Just s) wrs = applyMagnifier z r s wrs
|
||||||
redoLayout (Mag z On NoMaster) = unlessMaster $ applyMagnifier z
|
redoLayout (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs
|
||||||
redoLayout _ = nothing
|
redoLayout _ _ _ wrs = return (wrs, Nothing)
|
||||||
where nothing _ _ wrs = return (wrs, Nothing)
|
|
||||||
|
|
||||||
handleMess (Mag z On t) m
|
handleMess (Mag z On t) m
|
||||||
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t)
|
| Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto` 0.1) On t)
|
||||||
|
@ -75,15 +75,10 @@ data SmartBorder a = SmartBorder [a] deriving (Read, Show)
|
|||||||
instance LayoutModifier SmartBorder Window where
|
instance LayoutModifier SmartBorder Window where
|
||||||
unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
|
unhook (SmartBorder s) = asks (borderWidth . config) >>= setBorders s
|
||||||
|
|
||||||
redoLayout sb _ st wrs = genericLayoutMod sb (W.integrate st) wrs
|
redoLayout (SmartBorder s) _ mst wrs = do
|
||||||
|
|
||||||
emptyLayoutMod sb _ wrs = genericLayoutMod sb [] wrs
|
|
||||||
|
|
||||||
genericLayoutMod :: (SmartBorder Window) -> [Window] -> [(Window, b)] ->
|
|
||||||
X ([(Window, b)], Maybe (SmartBorder Window))
|
|
||||||
genericLayoutMod (SmartBorder s) managedwindows wrs = do
|
|
||||||
wset <- gets windowset
|
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
|
ws = tiled ++ floating
|
||||||
tiled = case filter (`elem` managedwindows) $ map fst wrs of
|
tiled = case filter (`elem` managedwindows) $ map fst wrs of
|
||||||
[w] | singleton screens -> [w]
|
[w] | singleton screens -> [w]
|
||||||
|
@ -70,8 +70,6 @@ defaultSWNConfig =
|
|||||||
instance LayoutModifier ShowWName a where
|
instance LayoutModifier ShowWName a where
|
||||||
redoLayout sn r _ wrs = doShow sn r wrs
|
redoLayout sn r _ wrs = doShow sn r wrs
|
||||||
|
|
||||||
emptyLayoutMod sn r wrs = doShow sn r wrs
|
|
||||||
|
|
||||||
handleMess (SWN _ c (Just (i,w))) m
|
handleMess (SWN _ c (Just (i,w))) m
|
||||||
| Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
|
| Just e <- fromMessage m = handleTimer i e (deleteWindow w >> return Nothing)
|
||||||
| Just Hide <- fromMessage m = do deleteWindow w
|
| Just Hide <- fromMessage m = do deleteWindow w
|
||||||
|
@ -109,9 +109,9 @@ type ArrangeAll = Bool
|
|||||||
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
|
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
|
||||||
|
|
||||||
instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
|
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
|
where
|
||||||
wins = map fst *** map awrWin
|
wins = map fst *** map awrWin
|
||||||
update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)
|
update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)
|
||||||
|
@ -106,7 +106,7 @@ configurableNavigation :: LayoutClass l a => WNConfig -> l a -> ModifiedLayout W
|
|||||||
configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
|
configurableNavigation conf = ModifiedLayout (WindowNavigation conf (I Nothing))
|
||||||
|
|
||||||
instance LayoutModifier WindowNavigation Window where
|
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
|
do XConf { normalBorder = nbc, focusedBorder = fbc, display = dpy } <- ask
|
||||||
[uc,dc,lc,rc] <-
|
[uc,dc,lc,rc] <-
|
||||||
case brightness conf of
|
case brightness conf of
|
||||||
@ -136,6 +136,7 @@ instance LayoutModifier WindowNavigation Window where
|
|||||||
mapM_ (sc nbc) (wothers \\ map fst wnavigable)
|
mapM_ (sc nbc) (wothers \\ map fst wnavigable)
|
||||||
mapM_ (\(win,c) -> sc c win) wnavigablec
|
mapM_ (\(win,c) -> sc c win) wnavigablec
|
||||||
return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
|
return (origwrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
|
||||||
|
redoLayout _ _ _ origwrs = return (origwrs, Nothing)
|
||||||
|
|
||||||
handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
|
handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
|
||||||
| Just (Go d) <- fromMessage m =
|
| Just (Go d) <- fromMessage m =
|
||||||
|
Loading…
x
Reference in New Issue
Block a user