Merge pull request #688 from liskin/dynamic-workspaces-nub-refresh-loop

X.H.ManageDocks: Avoid unnecessary refresh (loop) for decorations

This started as an investigation of the root cause of
<https://github.com/xmonad/xmonad-contrib/issues/565>, which was
addressed by <https://github.com/xmonad/xmonad-contrib/pull/621> without
having a full understanding of why xmonad ends up in a busy loop.

What was going on:

* X.L.SubLayouts group update algorithm assumes no duplicities in the
  Stack, and results in multiplying those duplicities otherwise. Note
  that this is a reasonable assumption—duplicities in a Stack have no
  defined behaviour in xmonad (X11 can't place a window on a screen
  twice), so "fixing" this algorithm is a waste of time.

* X.L.Decoration creates windows which X.H.ManageDocks treats as
  possible docks, resulting in extra refresh whenever they appear.

* The extra refresh causes X.L.SubLayouts to multiply the duplicities,
  X.L.Decoration to create new decoration windows, and these invalidate
  the X.H.ManageDocks strut cache, leading to yet another refresh, and
  an endless loop of these.

Having concluded that the no-duplicities assumption is a reasonable one,
there's nothing really to fix here after
<https://github.com/xmonad/xmonad-contrib/pull/621>. Still, the extra
refresh might be causing extra flicker in decorated layouts, and we can
easily avoid it, so I do that here. Plus a bit of documentation for
X.L.SubLayouts.

XMonad/Hooks/ManageDocks.hs

@@ -148,15 +148,20 @@ requestDockEvents w = whenX (not <$> isClient w) $ withDisplay $ \dpy ->
     withWindowAttributes dpy w $ \attrs -> io $ selectInput dpy w $
         wa_your_event_mask attrs .|. propertyChangeMask .|. structureNotifyMask
 
--- | Checks if a window is a DOCK or DESKTOP window
+-- | Checks if a window is a DOCK or DESKTOP window.
+-- Ignores xmonad's own windows (usually _NET_WM_WINDOW_TYPE_DESKTOP) to avoid
+-- unnecessary refreshes.
 checkDock :: Query Bool
-checkDock = ask >>= \w -> liftX $ do
+checkDock = isDockOrDesktop <&&> (not <$> isXMonad)
-    dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
+  where
-    desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
+    isDockOrDesktop = ask >>= \w -> liftX $ do
-    mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
+        dock <- getAtom "_NET_WM_WINDOW_TYPE_DOCK"
-    case mbr of
+        desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
-        Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs
+        mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
-        _       -> return False
+        case mbr of
+            Just rs -> return $ any ((`elem` [dock,desk]) . fromIntegral) rs
+            _       -> return False
+    isXMonad = className =? "xmonad"
 
 -- | Whenever a new dock appears, refresh the layout immediately to avoid the
 -- new dock.

XMonad/Layout/SubLayouts.hs

@@ -1,4 +1,11 @@
-{-# LANGUAGE PatternGuards, ParallelListComp, FlexibleInstances, FlexibleContexts, MultiParamTypeClasses, ViewPatterns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ParallelListComp #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.SubLayouts
@@ -298,7 +305,7 @@ onGroup f = withFocused (sendMessage . WithGroup (return . f))
 toSubl :: (Message a) => a -> X ()
 toSubl m = withFocused (sendMessage . SubMessage (SomeMessage m))
 
-instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where
+instance forall l. (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModifier (Sublayout l) Window where
     modifyLayout Sublayout{ subls = osls } (W.Workspace i la st) r = do
             let gs' = updateGroup st $ toGroups osls
                 st' = W.filter (`elem` M.keys gs') =<< st
@@ -398,10 +405,8 @@ instance (Read (l Window), Show (l Window), LayoutClass l Window) => LayoutModif
 
            findGroup z = mplus (M.lookup z gs) $ listToMaybe
                     $ M.elems $ M.filter ((z `elem`) . W.integrate) gs
-           -- catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
+
-           --  This l must be the same as from the instance head,
+           catchLayoutMess :: LayoutMessages -> X (Maybe (Sublayout l Window))
-           --  -XScopedTypeVariables should bring it into scope, but we are
-           --  trying to avoid warnings with ghc-6.8.2 and avoid CPP
            catchLayoutMess x = do
             let m' = x `asTypeOf` (undefined :: LayoutMessages)
             ms' <- zip (repeat $ SomeMessage m') . W.integrate'
@@ -417,7 +422,7 @@ updateGroup :: Ord a => Maybe (W.Stack a) -> Groups a -> Groups a
 updateGroup Nothing _ = mempty
 updateGroup (Just st) gs = fromGroupStack (toGroupStack gs st)
 
--- | rearrange the windowset to put the groups of tabs next to eachother, so
+-- | rearrange the windowset to put the groups of tabs next to each other, so
 -- that the stack of tabs stays put.
 updateWs :: Groups Window -> X ()
 updateWs = windowsMaybe . updateWs'
@@ -442,6 +447,11 @@ fromGroupStack = M.fromList . map (W.focus &&& id) . W.integrate
 
 -- | Arrange a stack of windows into a stack of stacks, according to (possibly
 -- outdated) Groups.
+--
+-- Assumes that the groups are disjoint and there are no duplicates in the
+-- stack; will result in additional duplicates otherwise. This is a reasonable
+-- assumption—the rest of xmonad will mishave too—but it isn't checked
+-- anywhere and there had been bugs breaking this assumption in the past.
 toGroupStack :: (Ord a) => Groups a -> W.Stack a -> GroupStack a
 toGroupStack gs st@(W.Stack f ls rs) =
     W.Stack (fromJust (lu f)) (mapMaybe lu ls) (mapMaybe lu rs)