From c48d81e37845184b62623aa08545e23859828f86 Mon Sep 17 00:00:00 2001 From: Bogdan Sinitsyn Date: Fri, 2 Sep 2016 23:07:59 +0300 Subject: [PATCH 1/3] Fix caching issues in ManageDocks Commits d638dc8b and a5e87e38 introduced a per-AvoidStruts-instance strut cache that a) didn't get initialized at startup, b) didn't get reinitialized after layout reset and c) didn't get updates if it wasn't the active layout, for example when layoutHook = avoidStruts tall ||| avoidStruts (mirror tall) a) + b) could be fixed by using the docksStartupHook introduced in 28e9f8bc, although this wasn't documented and having to call docksStartupHook after setLayout is far from obvious. By moving the strut cache from AvoidStruts instances to a global state, b) and c) are fixed. One still has to invoke the docksStartupHook for a), and this will be addressed in the next commit. --- XMonad/Actions/FloatSnap.hs | 4 +- XMonad/Hooks/ManageDocks.hs | 139 +++++++++++------------------ XMonad/Hooks/PositionStoreHooks.hs | 2 +- XMonad/Layout/DecorationAddons.hs | 4 +- 4 files changed, 57 insertions(+), 92 deletions(-) diff --git a/XMonad/Actions/FloatSnap.hs b/XMonad/Actions/FloatSnap.hs index 2d04fd307c..baf511f3e2 100644 --- a/XMonad/Actions/FloatSnap.hs +++ b/XMonad/Actions/FloatSnap.hs @@ -33,7 +33,7 @@ import Data.Maybe (listToMaybe,fromJust,isNothing) import qualified XMonad.StackSet as W import qualified Data.Set as S -import XMonad.Hooks.ManageDocks (calcGapForAll) +import XMonad.Hooks.ManageDocks (calcGap) import XMonad.Util.Types (Direction2D(..)) import XMonad.Actions.AfterDrag @@ -291,7 +291,7 @@ getSnap horiz collidedist d w = do screen <- W.current <$> gets windowset let sr = screenRect $ W.screenDetail screen wl = W.integrate' . W.stack $ W.workspace screen - gr <- fmap ($sr) $ calcGapForAll $ S.fromList [minBound .. maxBound] + gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound] wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl) return ( neighbours (back wa sr gr wla) (wpos wa) diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index a1ee158ae3..7f3cbbf39d 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -28,7 +28,7 @@ module XMonad.Hooks.ManageDocks ( #endif -- for XMonad.Actions.FloatSnap - calcGap, calcGapForAll + calcGap ) where @@ -39,12 +39,12 @@ import XMonad.Layout.LayoutModifier import XMonad.Util.Types import XMonad.Util.WindowProperties (getProp32s) import XMonad.Util.XUtils (fi) +import qualified XMonad.Util.ExtensibleState as XS import Data.Monoid (All(..), mempty) import Data.Functor((<$>)) import qualified Data.Set as S import qualified Data.Map as M -import Data.Maybe (fromMaybe) import Control.Monad (when, forM_, filterM) -- $usage @@ -101,6 +101,33 @@ import Control.Monad (when, forM_, filterM) -- "XMonad.Doc.Extending#Editing_key_bindings". -- +newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] } + deriving (Eq, Typeable) + +data UpdateDocks = UpdateDocks deriving Typeable +instance Message UpdateDocks + +refreshDocks :: X () +refreshDocks = sendMessage UpdateDocks + +instance ExtensionClass StrutCache where + initialValue = StrutCache M.empty + +modifyXS :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool +modifyXS f = do + v <- XS.get + case f v of + v' | v' == v -> return False + | otherwise -> XS.put v' >> return True + +updateStrutCache :: Window -> [Strut] -> X Bool +updateStrutCache w strut = do + modifyXS $ StrutCache . M.insert w strut . fromStrutCache + +deleteFromStructCache :: Window -> X Bool +deleteFromStructCache w = do + modifyXS $ StrutCache . M.delete w . fromStrutCache + -- | Detects if the given window is of type DOCK and if so, reveals -- it, but does not manage it. manageDocks :: ManageHook @@ -125,9 +152,8 @@ checkDock = ask >>= \w -> liftX $ do docksEventHook :: Event -> X All docksEventHook (MapNotifyEvent { ev_window = w }) = do whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do - strut <- getRawStrut w - sendMessage $ UpdateDock w strut - broadcastMessage $ UpdateDock w strut + strut <- getStrut w + whenX (updateStrutCache w strut) refreshDocks return (All True) docksEventHook (PropertyEvent { ev_window = w , ev_atom = a }) = do @@ -135,13 +161,11 @@ docksEventHook (PropertyEvent { ev_window = w nws <- getAtom "_NET_WM_STRUT" nwsp <- getAtom "_NET_WM_STRUT_PARTIAL" when (a == nws || a == nwsp) $ do - strut <- getRawStrut w - broadcastMessage $ UpdateDock w strut - refresh + strut <- getStrut w + whenX (updateStrutCache w strut) refreshDocks return (All True) docksEventHook (DestroyWindowEvent {ev_window = w}) = do - sendMessage (RemoveDock w) - broadcastMessage (RemoveDock w) + whenX (deleteFromStructCache w) refreshDocks return (All True) docksEventHook _ = return (All True) @@ -151,23 +175,9 @@ docksStartupHook = withDisplay $ \dpy -> do (_,_,wins) <- io $ queryTree dpy rootw docks <- filterM (runQuery checkDock) wins forM_ docks $ \win -> do - strut <- getRawStrut win - broadcastMessage (UpdateDock win strut) - refresh - -getRawStrut :: Window -> X (Maybe (Either [CLong] [CLong])) -getRawStrut w = do - msp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT_PARTIAL" w - if null msp - then do - mp <- fromMaybe [] <$> getProp32s "_NET_WM_STRUT" w - if null mp then return Nothing - else return $ Just (Left mp) - else return $ Just (Right msp) - -getRawStruts :: [Window] -> X (M.Map Window (Maybe (Either [CLong] [CLong]))) -getRawStruts wins = M.fromList <$> zip wins <$> mapM getRawStrut wins - + strut <- getStrut win + updateStrutCache win strut + refreshDocks -- | Gets the STRUT config, if present, in xmonad gap order getStrut :: Window -> X [Strut] @@ -185,18 +195,12 @@ getStrut w = do [(L, l, ly1, ly2), (R, r, ry1, ry2), (U, t, tx1, tx2), (D, b, bx1, bx2)] parseStrutPartial _ = [] -calcGapForAll :: S.Set Direction2D -> X (Rectangle -> Rectangle) -calcGapForAll ss = withDisplay $ \dpy -> do - rootw <- asks theRoot - (_,_,wins) <- io $ queryTree dpy rootw - calcGap wins ss - -- | Goes through the list of windows and find the gap so that all -- STRUT settings are satisfied. -calcGap :: [Window] -> S.Set Direction2D -> X (Rectangle -> Rectangle) -calcGap wins ss = withDisplay $ \dpy -> do +calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle) +calcGap ss = withDisplay $ \dpy -> do rootw <- asks theRoot - struts <- (filter careAbout . concat) `fmap` mapM getStrut wins + struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache) -- we grab the window attributes of the root window rather than checking -- the width of the screen because xlib caches this info and it tends to @@ -218,13 +222,9 @@ avoidStrutsOn :: LayoutClass l a => [Direction2D] -> l a -> ModifiedLayout AvoidStruts l a -avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) Nothing M.empty +avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss) -data AvoidStruts a = AvoidStruts { - avoidStrutsDirection :: S.Set Direction2D, - avoidStrutsRectCache :: Maybe (S.Set Direction2D, Rectangle, Rectangle), - strutMap :: M.Map Window (Maybe (Either [CLong] [CLong])) -} deriving ( Read, Show ) +data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show ) -- | Message type which can be sent to an 'AvoidStruts' layout -- modifier to alter its behavior. @@ -234,15 +234,6 @@ data ToggleStruts = ToggleStruts instance Message ToggleStruts - --- | message sent to ensure that caching the gaps won't give a wrong result --- because a new dock has been added -data DockMessage = UpdateDock Window (Maybe (Either [CLong] [CLong])) - | RemoveDock Window - deriving (Read,Show,Typeable) -instance Message DockMessage - - -- | SetStruts is a message constructor used to set or unset specific struts, -- regardless of whether or not the struts were originally set. Here are some -- example bindings: @@ -270,44 +261,18 @@ data SetStruts = SetStruts { addedStruts :: [Direction2D] instance Message SetStruts instance LayoutModifier AvoidStruts a where - modifyLayoutWithUpdate as@(AvoidStruts ss cache smap) w r = do - let dockWins = M.keys smap - (nr, nsmap) <- case cache of - Just (ss', r', nr) | ss' == ss, r' == r -> do - nsmap <- getRawStruts dockWins - if nsmap /= smap - then do - wnr <- fmap ($ r) (calcGap dockWins ss) - setWorkarea wnr - return (wnr, nsmap) - else do - return (nr, smap) - _ -> do - nsset <- getRawStruts dockWins - nr <- fmap ($ r) (calcGap dockWins ss) - setWorkarea nr - return (nr, nsset) - arranged <- runLayout w nr - let newCache = Just (ss, r, nr) - return (arranged, if newCache == cache && smap == nsmap - then Nothing - else Just as { avoidStrutsRectCache = newCache - , strutMap = nsmap }) - - pureMess as@(AvoidStruts { avoidStrutsDirection = ss, strutMap = sm }) m - | Just ToggleStruts <- fromMessage m = Just $ as { avoidStrutsDirection = toggleAll ss } - | Just (ToggleStrut s) <- fromMessage m = Just $ as { avoidStrutsDirection = toggleOne s ss } + modifyLayout (AvoidStruts ss) w r = do + srect <- fmap ($ r) (calcGap ss) + setWorkarea srect + runLayout w srect + + pureMess as@(AvoidStruts ss) m + | Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss) + | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss) | Just (SetStruts n k) <- fromMessage m , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k) - , newSS /= ss = Just $ as { avoidStrutsDirection = newSS } - | Just (UpdateDock dock strut) <- fromMessage m = if maybe True (/= strut) (M.lookup dock sm) - then Just $ as { avoidStrutsRectCache = Nothing - , strutMap = M.insert dock strut sm } - else Nothing - | Just (RemoveDock dock) <- fromMessage m = if M.member dock sm - then Just $ as { avoidStrutsRectCache = Nothing - , strutMap = M.delete dock sm } - else Nothing + , newSS /= ss = Just $ AvoidStruts newSS + | Just UpdateDocks <- fromMessage m = Just as | otherwise = Nothing where toggleAll x | S.null x = S.fromList [minBound .. maxBound] | otherwise = S.empty diff --git a/XMonad/Hooks/PositionStoreHooks.hs b/XMonad/Hooks/PositionStoreHooks.hs index 2a41cf6763..e32c3c919a 100644 --- a/XMonad/Hooks/PositionStoreHooks.hs +++ b/XMonad/Hooks/PositionStoreHooks.hs @@ -88,7 +88,7 @@ positionStoreInit mDecoTheme w = withDisplay $ \d -> do else do sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa) let sr = screenRect . W.screenDetail $ sc - sr' <- fmap ($ sr) (calcGapForAll $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting + sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting -- a somewhat unfortunate inter-dependency -- with 'XMonad.Hooks.ManageDocks' modifyPosStore (\ps -> posStoreInsert ps w diff --git a/XMonad/Layout/DecorationAddons.hs b/XMonad/Layout/DecorationAddons.hs index 9a7e23aab2..0f4a799873 100644 --- a/XMonad/Layout/DecorationAddons.hs +++ b/XMonad/Layout/DecorationAddons.hs @@ -106,8 +106,8 @@ handleScreenCrossing w decoWin = withDisplay $ \d -> do {-- somewhat ugly hack to get proper ScreenRect, creates unwanted inter-dependencies TODO: get ScreenRects in a proper way --} - oldScreenRect' <- fmap ($ oldScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) - newScreenRect' <- fmap ($ newScreenRect) (calcGapForAll $ S.fromList [minBound .. maxBound]) + oldScreenRect' <- fmap ($ oldScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) + newScreenRect' <- fmap ($ newScreenRect) (calcGap $ S.fromList [minBound .. maxBound]) wa <- io $ getWindowAttributes d decoWin modifyPosStore (\ps -> posStoreMove ps w (fi $ wa_x wa) (fi $ wa_y wa) From e38fb3bdb8bba7e09cc598fd37a06545ce18229f Mon Sep 17 00:00:00 2001 From: Tomas Janousek Date: Tue, 6 Sep 2016 16:46:03 +0200 Subject: [PATCH 2/3] Make usage of ManageDocks simpler and more robust As it now consists of a startup hook, a manage hook, an event hook and a layout modifier, and behaves erratically when any one component is not included in a user's config (which happens to be the case for all configs from xmonad-contrib 0.12 since the startup hook is a new inclusion), it's probably wise to have a single function that adds all the hooks to the config instead. NB: This will need a release notes entry anyway! --- XMonad/Config/Bluetile.hs | 4 ++-- XMonad/Config/Desktop.hs | 6 ++---- XMonad/Config/Dmwit.hs | 3 +-- XMonad/Config/Droundy.hs | 5 ++--- XMonad/Config/Sjanssen.hs | 4 ++-- XMonad/Hooks/DynamicLog.hs | 3 +-- XMonad/Hooks/EwmhDesktops.hs | 2 +- XMonad/Hooks/ManageDocks.hs | 32 +++++++++++--------------------- 8 files changed, 22 insertions(+), 37 deletions(-) diff --git a/XMonad/Config/Bluetile.hs b/XMonad/Config/Bluetile.hs index e0aaea6819..826b66a63f 100644 --- a/XMonad/Config/Bluetile.hs +++ b/XMonad/Config/Bluetile.hs @@ -180,8 +180,7 @@ bluetileManageHook :: ManageHook bluetileManageHook = composeAll [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons) , className =? "MPlayer" --> doFloat - , isFullscreen --> doFullFloat - , manageDocks] + , isFullscreen --> doFullFloat] bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( named "Floating" floating ||| @@ -199,6 +198,7 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ ( floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l bluetileConfig = + docks $ def { modMask = mod4Mask, -- logo key manageHook = bluetileManageHook, diff --git a/XMonad/Config/Desktop.hs b/XMonad/Config/Desktop.hs index 088aef8780..46d75f7a4d 100644 --- a/XMonad/Config/Desktop.hs +++ b/XMonad/Config/Desktop.hs @@ -164,11 +164,9 @@ import qualified Data.Map as M -- > adjustEventInput -- -desktopConfig = ewmh def - { startupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook <+> startupHook def +desktopConfig = docks $ ewmh def + { startupHook = setDefaultCursor xC_left_ptr <+> startupHook def , layoutHook = desktopLayoutModifiers $ layoutHook def - , manageHook = manageDocks <+> manageHook def - , handleEventHook = docksEventHook <+> handleEventHook def , keys = desktopKeys <+> keys def } desktopKeys (XConfig {modMask = modm}) = M.fromList $ diff --git a/XMonad/Config/Dmwit.hs b/XMonad/Config/Dmwit.hs index a4b6aa6bab..4a85ba61e5 100644 --- a/XMonad/Config/Dmwit.hs +++ b/XMonad/Config/Dmwit.hs @@ -205,7 +205,7 @@ instance PPrint ScreenId instance (Show a, Show b) => PPrint (Map a b) -- }}} -- main {{{ -dmwitConfig nScreens = def { +dmwitConfig nScreens = docks $ def { borderWidth = 2, workspaces = withScreens nScreens (map show [1..5]), terminal = "urxvt", @@ -221,7 +221,6 @@ dmwitConfig nScreens = def { <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169) <+> fullscreenMPlayer <+> floatAll ["Gimp", "Wine"] - <+> manageDocks <+> manageSpawn, logHook = allPPs nScreens, startupHook = refresh diff --git a/XMonad/Config/Droundy.hs b/XMonad/Config/Droundy.hs index a26dbaea51..31f560ce64 100644 --- a/XMonad/Config/Droundy.hs +++ b/XMonad/Config/Droundy.hs @@ -42,7 +42,7 @@ import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace, import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ), Direction1D( Prev, Next) ) -import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) +import XMonad.Hooks.ManageDocks ( avoidStruts, docks ) import XMonad.Hooks.EwmhDesktops ( ewmh ) myXPConfig :: XPConfig @@ -117,7 +117,7 @@ keys x = M.fromList $ ++ zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..]) -config = ewmh def +config = docks $ ewmh def { borderWidth = 1 -- Width of the window border in pixels. , XMonad.workspaces = ["mutt","iceweasel"] , layoutHook = showWName $ workspaceDir "~" $ @@ -129,7 +129,6 @@ config = ewmh def named "widescreen" ((mytab *||* mytab) ****//* combineTwo Square mytab mytab) -- ||| --mosaic 0.25 0.5 - , manageHook = manageHook def <+> manageDocks -- add panel-handling , terminal = "xterm" -- The preferred terminal program. , normalBorderColor = "#222222" -- Border color for unfocused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows. diff --git a/XMonad/Config/Sjanssen.hs b/XMonad/Config/Sjanssen.hs index 1f2d66e593..919ad0e7e6 100644 --- a/XMonad/Config/Sjanssen.hs +++ b/XMonad/Config/Sjanssen.hs @@ -21,7 +21,7 @@ import XMonad.Layout.TwoPane import qualified Data.Map as M sjanssenConfig = - ewmh $ def + docks $ ewmh $ def { terminal = "exec urxvt" , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int] , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $ @@ -35,7 +35,7 @@ sjanssenConfig = | (x, w) <- [ ("Firefox", "web") , ("Ktorrent", "7") , ("Amarokapp", "7")]] - <+> manageHook def <+> manageDocks <+> manageSpawn + <+> manageHook def <+> manageSpawn <+> (isFullscreen --> doFullFloat) , startupHook = mapM_ spawnOnce spawns } diff --git a/XMonad/Hooks/DynamicLog.hs b/XMonad/Hooks/DynamicLog.hs index c13a2fb52c..ba673d9e2e 100644 --- a/XMonad/Hooks/DynamicLog.hs +++ b/XMonad/Hooks/DynamicLog.hs @@ -199,12 +199,11 @@ statusBar :: LayoutClass l Window -> IO (XConfig (ModifiedLayout AvoidStruts l)) statusBar cmd pp k conf = do h <- spawnPipe cmd - return $ conf + return $ docks $ conf { layoutHook = avoidStruts (layoutHook conf) , logHook = do logHook conf dynamicLogWithPP pp { ppOutput = hPutStrLn h } - , manageHook = manageHook conf <+> manageDocks , keys = liftM2 M.union keys' (keys conf) } where diff --git a/XMonad/Hooks/EwmhDesktops.hs b/XMonad/Hooks/EwmhDesktops.hs index 9176691366..2508b7edb5 100644 --- a/XMonad/Hooks/EwmhDesktops.hs +++ b/XMonad/Hooks/EwmhDesktops.hs @@ -47,7 +47,7 @@ import XMonad.Util.WindowProperties (getProp32) -- > main = xmonad $ ewmh def{ handleEventHook = -- > handleEventHook def <+> fullscreenEventHook } -- --- You may also be interested in 'avoidStruts' from "XMonad.Hooks.ManageDocks". +-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks". -- | Add EWMH functionality to the given config. See above for an example. diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 7f3cbbf39d..6e7215981e 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -15,7 +15,7 @@ module XMonad.Hooks.ManageDocks ( -- * Usage -- $usage - manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, + docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn, docksEventHook, docksStartupHook, ToggleStruts(..), SetStruts(..), @@ -52,25 +52,16 @@ import Control.Monad (when, forM_, filterM) -- -- > import XMonad.Hooks.ManageDocks -- --- The first component is a 'ManageHook' which recognizes these --- windows and de-manages them, so that xmonad does not try to tile --- them. To enable it: +-- Wrap your xmonad config with a call to 'docks', like so: -- --- > manageHook = ... <+> manageDocks +-- > main = xmonad $ docks def -- --- The second component is a layout modifier that prevents windows --- from overlapping these dock windows. It is intended to replace --- xmonad's so-called \"gap\" support. First, you must add it to your --- list of layouts: +-- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout +-- to prevent windows from overlapping these windows. -- -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...) -- > where tall = Tall 1 (3/100) (1/2) -- --- The third component is an event hook that causes new docks to appear --- immediately, instead of waiting for the next focus change. --- --- > handleEventHook = ... <+> docksEventHook --- -- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding -- similar to: -- @@ -90,17 +81,16 @@ import Control.Monad (when, forM_, filterM) -- -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...) -- --- /Important note/: if you are switching from manual gaps --- (defaultGaps in your config) to avoidStruts (recommended, since --- manual gaps will probably be phased out soon), be sure to switch --- off all your gaps (with mod-b) /before/ reloading your config with --- avoidStruts! Toggling struts with a 'ToggleStruts' message will --- not work unless your gaps are set to zero. --- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". -- +-- | Add docks functionality to the given config. See above for an example. +docks :: XConfig a -> XConfig a +docks c = c { startupHook = docksStartupHook <+> startupHook c + , handleEventHook = docksEventHook <+> handleEventHook c + , manageHook = manageDocks <+> manageHook c } + newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] } deriving (Eq, Typeable) From fcb57bd657ec596dc3225be1d8551db2079eae40 Mon Sep 17 00:00:00 2001 From: Bogdan Sinitsyn Date: Tue, 25 Oct 2016 08:22:02 +0300 Subject: [PATCH 3/3] Move `modifyXS` to X.U.ExtensibleState --- XMonad/Hooks/ManageDocks.hs | 11 ++--------- XMonad/Util/ExtensibleState.hs | 8 ++++++++ 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/XMonad/Hooks/ManageDocks.hs b/XMonad/Hooks/ManageDocks.hs index 6e7215981e..d11d8110aa 100644 --- a/XMonad/Hooks/ManageDocks.hs +++ b/XMonad/Hooks/ManageDocks.hs @@ -103,20 +103,13 @@ refreshDocks = sendMessage UpdateDocks instance ExtensionClass StrutCache where initialValue = StrutCache M.empty -modifyXS :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool -modifyXS f = do - v <- XS.get - case f v of - v' | v' == v -> return False - | otherwise -> XS.put v' >> return True - updateStrutCache :: Window -> [Strut] -> X Bool updateStrutCache w strut = do - modifyXS $ StrutCache . M.insert w strut . fromStrutCache + XS.modified $ StrutCache . M.insert w strut . fromStrutCache deleteFromStructCache :: Window -> X Bool deleteFromStructCache w = do - modifyXS $ StrutCache . M.delete w . fromStrutCache + XS.modified $ StrutCache . M.delete w . fromStrutCache -- | Detects if the given window is of type DOCK and if so, reveals -- it, but does not manage it. diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs index 7fe3b0a77a..7e12a12cff 100644 --- a/XMonad/Util/ExtensibleState.hs +++ b/XMonad/Util/ExtensibleState.hs @@ -21,6 +21,7 @@ module XMonad.Util.ExtensibleState ( , remove , get , gets + , modified ) where import Data.Typeable (typeOf,cast) @@ -115,3 +116,10 @@ gets = flip fmap get -- | Remove the value from the extensible state field that has the same type as the supplied argument remove :: ExtensionClass a => a -> X () remove wit = modifyStateExts $ M.delete (show . typeOf $ wit) + +modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool +modified f = do + v <- get + case f v of + v' | v' == v -> return False + | otherwise -> put v' >> return True