Fix unmap handling

According to the ICCCM, clients should send a synthetic unmap event when they
initiate an unmap.  The old code waited for these synthetic unmaps to unmanage
windows.  However, certain 'obsolete' clients do not send synthetic unmaps
(notably xpdf's find dialog).  These windows entered a zombified state: xmonad
does not manage them, yet they are still mapped and raised on screen.

The new algorithm (derived from wmii):
 - track windows that are mapped on screen
 - track the number of expected unmap events for each window, increment every
   time 'hide' is called on a window that is not mapped.
 - decrement the expected unmap counter on each unmap event
 - treat an unmap event as genuine (ie. unmap the window) when:
    - the event is synthetic (per ICCCM)
    - OR there are no expected unmap events for this window

Main.hs

@@ -15,8 +15,10 @@
 
 import Data.Bits
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Control.Monad.Reader
 import Control.Monad.State
+import Data.Maybe (fromMaybe)
 
 import System.Environment (getArgs)
 
@@ -62,7 +64,9 @@ main = do
             { windowset     = winset
             , layouts       = M.fromList [(w, safeLayouts) | w <- [0 .. W workspaces - 1]]
             , statusGaps    = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0)
-            , xineScreens   = xinesc }
+            , xineScreens   = xinesc
+            , mapped        = S.empty
+            , waitingUnmap  = M.empty }
 
     xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
 
@@ -160,15 +164,13 @@ handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
 -- window gone,      unmanage it
 handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w
 
--- We only handle synthetic unmap events, because real events are confusable
--- with the events produced by 'hide'.  ICCCM says that all clients should send
--- synthetic unmap events immediately after unmapping, and later describes
--- clients that do not follow the rule as "obsolete".  For now, we make the
--- simplifying assumption that nobody uses clients that were already obsolete
--- in 1994.  Note that many alternative methods for resolving the hide/withdraw
--- ambiguity are racy.
-
-handle (UnmapEvent {ev_window = w, ev_send_event = True}) = whenX (isClient w) $ unmanage w
+-- We track expected unmap events in waitingUnmap.  We ignore this event unless
+-- it is synthetic or we are not expecting an unmap notification from a window.
+handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    if (synthetic || e == 0)
+        then unmanage w
+        else modify (\s -> s { waitingUnmap = M.adjust pred w (waitingUnmap s) })
 
 -- set keyboard mapping
 handle e@(MappingNotifyEvent {ev_window = w}) = do

Operations.hs

@@ -23,6 +23,7 @@ import Data.List            (genericIndex, intersectBy, partition)
 import Data.Bits            ((.|.), (.&.), complement)
 import Data.Ratio
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 import Control.Monad.State
 import Control.Monad.Reader
@@ -66,7 +67,10 @@ manage w = withDisplay $ \d -> do
 -- should also unmap?
 --
 unmanage :: Window -> X ()
-unmanage w = setWMState w 0 {-withdrawn-} >> windows (W.sink w . W.delete w)
+unmanage w = do
+    setWMState w 0 {-withdrawn-}
+    windows (W.sink w . W.delete w)
+    modify (\s -> s {mapped = S.delete w (mapped s), waitingUnmap = M.delete w (waitingUnmap s)})
 
 -- | focus. focus window up or down. or swap various windows.
 focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
@@ -196,9 +200,15 @@ setWMState w v = withDisplay $ \dpy -> do
 
 -- | hide. Hide a window by unmapping it, and setting Iconified.
 hide :: Window -> X ()
-hide  w = withDisplay $ \d -> do
-    io $ unmapWindow d w
+hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
+    io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
+            unmapWindow d w
+            selectInput d w clientMask
     setWMState w 3 --iconic
+    -- this part is key: we increment the waitingUnmap counter to distinguish
+    -- between client and xmonad initiated unmaps.
+    modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
+                    , mapped       = S.delete w (mapped s) })
 
 -- | reveal. Show a window by mapping it and setting Normal
 -- this is harmless if the window was already visible
@@ -206,11 +216,16 @@ reveal :: Window -> X ()
 reveal w = withDisplay $ \d -> do
     setWMState w 1 --normal
     io $ mapWindow d w
+    modify (\s -> s { mapped = S.insert w (mapped s) })
+
+-- | The client events that xmonad is interested in
+clientMask :: EventMask
+clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
 
 -- | Set some properties when we initially gain control of a window
 setInitialProperties :: Window -> X ()
 setInitialProperties w = withDisplay $ \d -> io $ do
-    selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
+    selectInput d w $ clientMask
     setWindowBorderWidth d w borderWidth
 
 -- | refresh. Render the currently visible workspaces, as determined by

XMonad.hs

@@ -34,6 +34,7 @@ import Graphics.X11.Xlib
 import Data.Typeable
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 -- | XState, the window manager state.
 -- Just the display, width, height and a window list
@@ -41,9 +42,10 @@ data XState = XState
     { windowset    :: !WindowSet           -- ^ workspace list
     , xineScreens  :: ![Rectangle]         -- ^ dimensions of each screen
     , statusGaps   :: ![(Int,Int,Int,Int)] -- ^ width of status bar on each screen
+    , mapped       :: !(S.Set Window)      -- ^ the Set of mapped windows
+    , waitingUnmap :: !(M.Map Window Int)  -- ^ the number of expected UnmapEvents
     , layouts      :: !(M.Map WorkspaceId (Layout, [Layout])) }
                        -- ^ mapping of workspaces to descriptions of their layouts
-
 data XConf = XConf
     { display       :: Display      -- ^ the X11 display
     , theRoot       :: !Window      -- ^ the root window