From 1e67a3f13c5ff800ebc6756deee22abb2e4fc6ba Mon Sep 17 00:00:00 2001 From: Joachim Breitner Date: Sun, 5 Oct 2008 21:02:20 +0200 Subject: 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. darcs-hash:20081005190220-23c07-4701517e3433ecff8c999da75ac582f6f1b65c19.gz --- XMonad/Actions/MouseResize.hs | 3 ++- XMonad/Layout/Decoration.hs | 12 ++++++------ XMonad/Layout/LayoutHints.hs | 3 ++- XMonad/Layout/LayoutModifier.hs | 40 +++++++++------------------------------ XMonad/Layout/Magnifier.hs | 7 +++---- XMonad/Layout/NoBorders.hs | 11 +++-------- XMonad/Layout/ShowWName.hs | 2 -- XMonad/Layout/WindowArranger.hs | 4 ++-- XMonad/Layout/WindowNavigation.hs | 3 ++- 9 files changed, 29 insertions(+), 56 deletions(-) diff --git a/XMonad/Actions/MouseResize.hs b/XMonad/Actions/MouseResize.hs index a0efb0d..e60bfae 100644 --- a/XMonad/Actions/MouseResize.hs +++ b/XMonad/Actions/MouseResize.hs @@ -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 diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index 2fad139..c17d71c 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -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' diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index 3558cc2..d263f3c 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -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 diff --git a/XMonad/Layout/LayoutModifier.hs b/XMonad/Layout/LayoutModifier.hs index 168e0df..b037911 100644 --- a/XMonad/Layout/LayoutModifier.hs +++ b/XMonad/Layout/LayoutModifier.hs @@ -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' diff --git a/XMonad/Layout/Magnifier.hs b/XMonad/Layout/Magnifier.hs index d9af9da..b27f2c7 100644 --- a/XMonad/Layout/Magnifier.hs +++ b/XMonad/Layout/Magnifier.hs @@ -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) diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs index c1210b4..99a877f 100644 --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -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] diff --git a/XMonad/Layout/ShowWName.hs b/XMonad/Layout/ShowWName.hs index 0aeeb32..b9e1586 100644 --- a/XMonad/Layout/ShowWName.hs +++ b/XMonad/Layout/ShowWName.hs @@ -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 diff --git a/XMonad/Layout/WindowArranger.hs b/XMonad/Layout/WindowArranger.hs index 926a900..7af39f0 100644 --- a/XMonad/Layout/WindowArranger.hs +++ b/XMonad/Layout/WindowArranger.hs @@ -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 (++) diff --git a/XMonad/Layout/WindowNavigation.hs b/XMonad/Layout/WindowNavigation.hs index e314f16..949c60f 100644 --- a/XMonad/Layout/WindowNavigation.hs +++ b/XMonad/Layout/WindowNavigation.hs @@ -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 = -- cgit v1.2.3