From 373fae3f1d7a521eca06930acdbd35cbc6fba7f4 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Mon, 9 Sep 2013 18:24:31 +0200
Subject: Add WindowState record

---
 XMonad/Core.hs | 35 +++++++++++++++++++++++++++++------
 1 file changed, 29 insertions(+), 6 deletions(-)

(limited to 'XMonad/Core.hs')

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"
-- 
cgit v1.2.3