diff options
| -rw-r--r-- | MetaTile/Core.hs | 37 | ||||
| -rw-r--r-- | MetaTile/Main.hsc | 3 | ||||
| -rw-r--r-- | MetaTile/Operations.hs | 5 |
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) -- --------------------------------------------------------------------- |