Add WindowState record

3 files changed, 38 insertions, 21 deletions

diff --git a/XMonad/Core.hs b/XMonad/Core.hs
index 958cd68..0ebb3fa 100644
--- a/XMonad/Core.hs
+++ b/XMonad/Core.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
+{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, PatternGuards,
              MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-}
 
 -----------------------------------------------------------------------------
@@ -17,14 +17,14 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Core (
-    X, WindowSet, WindowSpace, WorkspaceId,
+    X, WindowSet, WindowSpace, WorkspaceId, WindowState(..),
     ScreenId(..), ScreenDetail(..), XState(..),
     XConf(..), XConfig(..), LayoutClass(..),
     Layout(..), readsLayout, Typeable, Message,
     SomeMessage(..), fromMessage, LayoutMessages(..),
     StateExtension(..), ExtensionClass(..),
     runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
-    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
+    withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState,
     getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
   ) where
@@ -56,13 +56,18 @@ import Data.Maybe (isJust,fromMaybe)
 import Data.Monoid
 
 import qualified Data.Map as M
-import qualified Data.Set as S
+
+
+data WindowState = WindowState
+    { wsMapped       :: !Bool
+    , wsWaitingUnmap :: !Int         -- ^ the number of expected UnmapEvents
+    } deriving (Eq)
+
 
 -- | XState, the (mutable) window manager state.
 data XState = XState
     { windowset        :: !WindowSet                     -- ^ workspace list
-    , mapped           :: !(S.Set Window)                -- ^ the Set of mapped windows
-    , waitingUnmap     :: !(M.Map Window Int)            -- ^ the number of expected UnmapEvents
+    , windowState      :: !(M.Map Window WindowState)    -- ^ the extended window state
     , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
     , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
     , extensibleState  :: !(M.Map String (Either String StateExtension))
@@ -212,6 +217,24 @@ isRoot w = (w==) <$> asks theRoot
 getAtom :: String -> X Atom
 getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
 
+emptyWindowState :: WindowState
+emptyWindowState = WindowState False 0
+
+getWindowState :: Window -> X WindowState
+getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState
+
+getsWindowState :: (WindowState -> a) -> Window -> X a
+getsWindowState f w = f <$> getWindowState w
+
+setWindowState :: Window -> WindowState -> X ()
+setWindowState w ws = modify $ \s -> s { windowState = f (windowState s) }
+  where
+    f | ws == emptyWindowState = M.delete w
+      | otherwise              = M.insert w ws
+
+modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
+modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
+
 -- | Common non-predefined atoms
 atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
 atom_WM_PROTOCOLS       = getAtom "WM_PROTOCOLS"
diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc
index 653ec9d..19f988f 100644
--- a/XMonad/Main.hsc
+++ b/XMonad/Main.hsc
@@ -20,7 +20,6 @@ import Data.Bits
 import Data.List ((\\))
 import Data.Function
 import qualified Data.Map as M
-import qualified Data.Set as S
 import Control.Monad.Reader
 import Control.Monad.State
 import Data.Maybe (fromMaybe)
@@ -124,9 +123,8 @@ xmonad initxmc = do
 
         st = XState
             { windowset       = initialWinset
-            , numberlockMask   = 0
-            , mapped          = S.empty
-            , waitingUnmap    = M.empty
+            , numberlockMask  = 0
+            , windowState     = M.empty
             , dragging        = Nothing
             , extensibleState = extState
             }
@@ -205,18 +203,15 @@ handle (MapRequestEvent    {ev_window = w}) = withDisplay $ \dpy -> do
 -- window gone,      unmanage it
 handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do
     unmanage w
-    modify (\s -> s { mapped       = S.delete w (mapped s)
-                    , waitingUnmap = M.delete w (waitingUnmap s)})
+    modify (\s -> s { windowState = M.delete w (windowState s)})
 
 -- 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)
+    e <- getsWindowState wsWaitingUnmap w
     if (synthetic || e == 0)
         then unmanage w
-        else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
- where mpred 1 = Nothing
-       mpred n = Just $ pred n
+        else modifyWindowState (\ws -> ws { wsWaitingUnmap = (wsWaitingUnmap ws) - 1 }) w
 
 -- set keyboard mapping
 handle e@(MappingNotifyEvent {}) = do
diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs
index 4a3e3fc..79feba1 100644
--- a/XMonad/Operations.hs
+++ b/XMonad/Operations.hs
@@ -27,7 +27,6 @@ import Data.List            (nub, (\\), find)
 import Data.Bits            ((.|.), (.&.), complement, testBit)
 import Data.Ratio
 import qualified Data.Map as M
-import qualified Data.Set as S
 
 import Control.Applicative
 import Control.Monad.Reader
@@ -158,7 +157,7 @@ setWMState w v = withDisplay $ \dpy -> do
 
 -- | hide. Hide a window by unmapping it, and setting Iconified.
 hide :: Window -> X ()
-hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
+hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
     cMask <- asks $ clientMask . config
     io $ do selectInput d w (cMask .&. complement structureNotifyMask)
             unmapWindow d w
@@ -166,8 +165,8 @@ hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
     setWMState w iconicState
     -- 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) })
+    modifyWindowState (\ws -> ws { wsMapped       = False
+                                 , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w
 
 -- | reveal. Show a window by mapping it and setting Normal
 -- this is harmless if the window was already visible
@@ -175,7 +174,7 @@ reveal :: Window -> X ()
 reveal w = withDisplay $ \d -> do
     setWMState w normalState
     io $ mapWindow d w
-    whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) })
+    whenX (isClient w) $ modifyWindowState (\ws -> ws { wsMapped = True }) w
 
 -- | Set some properties when we initially gain control of a window
 setInitialProperties :: Window -> X ()