summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--MetaTile/Core.hs37
-rw-r--r--MetaTile/Main.hsc3
-rw-r--r--MetaTile/Operations.hs5
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)
-- ---------------------------------------------------------------------