Split up window and frame state

3 files changed, 34 insertions, 11 deletions

diff --git a/MetaTile/Core.hs b/MetaTile/Core.hs
index 5596ec3..572280b 100644
--- a/MetaTile/Core.hs
+++ b/MetaTile/Core.hs
@@ -18,13 +18,15 @@
 
 module MetaTile.Core (
     X, WindowSet, WindowSpace, WorkspaceId, BorderWidth(..), WindowState(..),
-    ScreenId(..), ScreenDetail(..), XState(..),
+    FrameState(..), 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, getWindowState, getsWindowState, setWindowState, modifyWindowState,
+    withDisplay, withWindowSet, isRoot, runOnWorkspaces,
+    getWindowState, getsWindowState, setWindowState, modifyWindowState,
+    getFrameState, getsFrameState, setFrameState, deleteFrameState, modifyFrameState,
     getAtom, spawn, spawnPID, xfork, getMetaTileDir, recompile, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
   ) where
@@ -35,11 +37,9 @@ import Prelude hiding ( catch )
 import Codec.Binary.UTF8.String (encodeString)
 import Control.Exception.Extensible (catch, fromException, try, bracket, throw, finally, SomeException(..))
 import Control.Applicative
-import Control.Arrow ((&&&))
 import Control.Monad.State
 import Control.Monad.Reader
 import Data.Default
-import Data.Function (on)
 import System.FilePath
 import System.IO
 import System.Info
@@ -71,17 +71,19 @@ data WindowState = WindowState
     { wsMapped       :: !Bool
     , wsWaitingUnmap :: !Int         -- ^ the number of expected UnmapEvents
     , wsFrame        :: !Window
-    , wsBorderWidth  :: !BorderWidth
-    } deriving Show
+    } deriving (Show, Eq)
 
-instance Eq WindowState where
-    (==) = (==) `on` (wsMapped &&& wsWaitingUnmap &&& wsFrame)
+data FrameState = FrameState
+    { fsWindow       :: !Window
+    , fsBorderWidth  :: !BorderWidth
+    } deriving Show
 
 
 -- | XState, the (mutable) window manager state.
 data XState = XState
     { windowset        :: !WindowSet                     -- ^ workspace list
     , windowState      :: !(M.Map Window WindowState)    -- ^ the extended window state
+    , frameState       :: !(M.Map Window FrameState)    -- ^ the extended frame state
     , dragging         :: !(Maybe (Position -> Position -> X (), X ()))
     , numberlockMask   :: !KeyMask                       -- ^ The numlock modifier
     , extensibleState  :: !(M.Map String (Either String StateExtension))
@@ -234,7 +236,7 @@ getAtom :: String -> X Atom
 getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
 
 emptyWindowState :: WindowState
-emptyWindowState = WindowState False 0 none (BorderWidth 0 0 0 0)
+emptyWindowState = WindowState False 0 none
 
 getWindowState :: Window -> X WindowState
 getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState
@@ -251,6 +253,23 @@ setWindowState w ws = do
 modifyWindowState :: (WindowState -> WindowState) -> Window -> X ()
 modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w
 
+
+getFrameState :: Window -> X (Maybe FrameState)
+getFrameState fr = gets $ M.lookup fr . frameState
+
+getsFrameState :: (FrameState -> a) -> Window -> X (Maybe a)
+getsFrameState f fr = fmap f <$> getFrameState fr
+
+setFrameState :: Window -> FrameState -> X ()
+setFrameState fr fs = modify $ \s -> s { frameState = M.insert fr fs (frameState s) }
+
+deleteFrameState :: Window -> X ()
+deleteFrameState fr = modify $ \s -> s { frameState = M.delete fr (frameState s) }
+
+modifyFrameState :: (FrameState -> FrameState) -> Window -> X ()
+modifyFrameState f fr = getFrameState fr >>= return . fmap f >>= maybe (return ()) (setFrameState fr)
+
+
 -- | 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/MetaTile/Main.hsc b/MetaTile/Main.hsc
index abdb75c..426e78f 100644
--- a/MetaTile/Main.hsc
+++ b/MetaTile/Main.hsc
@@ -126,6 +126,7 @@ metatile initxmc = do
             { windowset       = initialWinset
             , numberlockMask  = 0
             , windowState     = M.empty
+            , frameState     = M.empty
             , dragging        = Nothing
             , extensibleState = extState
             }
@@ -323,6 +324,7 @@ reparent w = withDisplay $ \dpy -> do
             addToSaveSet dpy w
             reparentWindow dpy w frame 0 0
         modifyWindowState (\ws -> ws { wsFrame = frame }) w
+        setFrameState frame $ FrameState { fsWindow = w, fsBorderWidth = BorderWidth 0 0 0 0 }
 
 hideParent :: Window -> X ()
 hideParent w = withDisplay $ \dpy -> do
@@ -336,6 +338,7 @@ unparent w = withDisplay $ \dpy -> do
         trace $ "unparent: " ++ show w
         io $ destroyWindow dpy frame
         modifyWindowState (\ws -> ws { wsFrame = none }) w
+        deleteFrameState frame
 
 -- ---------------------------------------------------------------------
 -- IO stuff. Doesn't require any X state
diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs
index db2e264..b45403f 100644
--- a/MetaTile/Operations.hs
+++ b/MetaTile/Operations.hs
@@ -190,7 +190,8 @@ hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do
 
 configureClientWindow :: Window -> X ()
 configureClientWindow w = withDisplay $ \d -> do
-    (frame, bw) <- getsWindowState (wsFrame &&& wsBorderWidth) w
+    frame <- getsWindowState wsFrame w
+    Just bw <- getsFrameState fsBorderWidth frame
     (_, x, y, width, height, _, _) <- io $ getGeometry d frame
     let least1 n = max 1 n
         x' = x + (fi $ bwLeft bw)
@@ -251,7 +252,7 @@ tileWindow w r bw = withDisplay $ \d -> do
     let least x | x <= 0  = 1
                 | otherwise  = x
     frame <- getsWindowState wsFrame w
-    modifyWindowState (\ws -> ws {wsBorderWidth = bw}) w
+    modifyFrameState (\fs -> fs {fsBorderWidth = bw}) frame
     io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r)
 
 -- ---------------------------------------------------------------------