diff options
| -rw-r--r-- | Main.hs | 16 | ||||
| -rw-r--r-- | Operations.hs | 20 | ||||
| -rw-r--r-- | XMonad.hs | 24 |
3 files changed, 35 insertions, 25 deletions
@@ -21,6 +21,7 @@ import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama import Control.Monad.State +import Control.Monad.Reader import qualified StackSet as W @@ -44,7 +45,7 @@ main = do nbc <- initcolor normalBorderColor fbc <- initcolor focusedBorderColor - let st = XState + let cf = XConf { display = dpy , xineScreens = xinesc , theRoot = rootw @@ -53,12 +54,14 @@ main = do -- fromIntegral needed for X11 versions that use Int instead of CInt. , dimensions = (fromIntegral (displayWidth dpy dflt), fromIntegral (displayHeight dpy dflt)) - , workspace = W.empty workspaces (length xinesc) , defaultLayoutDesc = startingLayoutDesc - , layoutDescs = M.empty , normalBorder = nbc , focusedBorder = fbc } + st = XState + { workspace = W.empty workspaces (length xinesc) + , layoutDescs = M.empty + } xSetErrorHandler -- in C, I'm too lazy to write the binding @@ -73,7 +76,7 @@ main = do ws <- scan dpy rootw allocaXEvent $ \e -> - runX st $ do + runX cf st $ do mapM_ manage ws forever $ handle =<< xevent dpy e where @@ -170,12 +173,13 @@ handle e@(CrossingEvent {ev_window = w, ev_event_type = t}) -- left a window, check if we need to focus root handle e@(CrossingEvent {ev_event_type = t}) | t == leaveNotify - = do rootw <- gets theRoot + = do rootw <- asks theRoot when (ev_window e == rootw && not (ev_same_screen e)) $ setFocus rootw -- configure a window handle e@(ConfigureRequestEvent {ev_window = w}) = do - XState { display = dpy, workspace = ws } <- get + dpy <- asks display + ws <- gets workspace when (W.member w ws) $ -- already managed, reconfigure (see client:configure() trace ("Reconfigure already managed window: " ++ show w) diff --git a/Operations.hs b/Operations.hs index 84ca456..ae9232b 100644 --- a/Operations.hs +++ b/Operations.hs @@ -18,6 +18,7 @@ import Data.Bits import qualified Data.Map as M import Control.Monad.State +import Control.Monad.Reader import Control.Arrow (second) import System.Posix.Process @@ -39,8 +40,8 @@ import qualified StackSet as W -- screen and raises the window. refresh :: X () refresh = do - XState {workspace = ws, xineScreens = xinesc - ,display = d ,layoutDescs = fls ,defaultLayoutDesc = dfltfl } <- get + XState { workspace = ws, layoutDescs = fls } <- get + XConf { xineScreens = xinesc, display = d, defaultLayoutDesc = dfltfl } <- ask flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do let sc = genericIndex xinesc scn -- temporary coercion! @@ -57,7 +58,7 @@ refresh = do -- | clearEnterEvents. Remove all window entry events from the event queue. clearEnterEvents :: X () clearEnterEvents = do - d <- gets display + d <- asks display io $ sync d False io $ allocaXEvent $ \p -> fix $ \again -> do more <- checkMaskEvent d enterWindowMask p @@ -103,10 +104,11 @@ changeSplit delta = layout $ \fl -> -- function and refresh. layout :: (LayoutDesc -> LayoutDesc) -> X () layout f = do + dfl <- asks defaultLayoutDesc modify $ \s -> let fls = layoutDescs s n = W.current . workspace $ s - fl = M.findWithDefault (defaultLayoutDesc s) n fls + fl = M.findWithDefault dfl n fls in s { layoutDescs = M.insert n (f fl) fls } refresh @@ -121,7 +123,7 @@ windows f = do -- | hide. Hide a window by moving it offscreen. hide :: Window -> X () hide w = withDisplay $ \d -> do - (sw,sh) <- gets dimensions + (sw,sh) <- asks dimensions io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh) -- --------------------------------------------------------------------- @@ -189,8 +191,8 @@ safeFocus w = do ws <- gets workspace -- | Explicitly set the keyboard focus to the given window setFocus :: Window -> X () setFocus w = do - XState { workspace = ws, display = dpy - , normalBorder = nbc, focusedBorder = fbc } <- get + ws <- gets workspace + XConf { display = dpy , normalBorder = nbc, focusedBorder = fbc } <- ask -- clear mouse button grab and border on other windows flip mapM_ (W.visibleWorkspaces ws) $ \n -> do @@ -212,7 +214,7 @@ setTopFocus = do ws <- gets workspace case W.peek ws of Just new -> setFocus new - Nothing -> gets theRoot >>= setFocus + Nothing -> asks theRoot >>= setFocus -- | raise. focus to window at offset 'n' in list. -- The currently focused window is always the head of the list @@ -229,7 +231,7 @@ kill = withDisplay $ \d -> do ws <- gets workspace whenJust (W.peek ws) $ \w -> do protocols <- io $ getWMProtocols d w - XState {wmdelete = wmdelt, wmprotocols = wmprot} <- get + XConf {wmdelete = wmdelt, wmprotocols = wmprot} <- ask if wmdelt `elem` protocols then io $ allocaXEvent $ \ev -> do setEventType ev clientMessage @@ -16,13 +16,14 @@ -- module XMonad ( - X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), Layout(..), LayoutDesc(..), - runX, io, withDisplay, isRoot, spawn, trace, whenJust, rotateLayout + X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), + LayoutDesc(..), runX, io, withDisplay, isRoot, spawn, trace, whenJust, rotateLayout ) where import StackSet (StackSet) import Control.Monad.State +import Control.Monad.Reader import System.IO import System.Posix.Process (executeFile, forkProcess, getProcessStatus) import System.Exit @@ -33,6 +34,11 @@ import qualified Data.Map as M -- | XState, the window manager state. -- Just the display, width, height and a window list data XState = XState + { workspace :: !WindowSet -- ^ workspace list + , layoutDescs :: !(M.Map WorkspaceId LayoutDesc) -- ^ mapping of workspaces + } + +data XConf = XConf { display :: Display -- ^ the X11 display , theRoot :: !Window -- ^ the root window @@ -40,11 +46,9 @@ data XState = XState , wmprotocols :: !Atom -- ^ wm protocols atom , dimensions :: !(Int,Int) -- ^ dimensions of the screen, -- used for hiding windows - , workspace :: !WindowSet -- ^ workspace list , xineScreens :: ![Rectangle] -- ^ dimensions of each screen , defaultLayoutDesc :: !LayoutDesc -- ^ default layout - , layoutDescs :: !(M.Map WorkspaceId LayoutDesc) -- ^ mapping of workspaces -- to descriptions of their layouts , normalBorder :: !Color -- ^ border color of unfocused windows , focusedBorder :: !Color -- ^ border color of the focused window @@ -62,24 +66,24 @@ newtype ScreenId = S Int deriving (Eq,Ord,Show,Enum,Num,Integral,Real) -- | The X monad, a StateT transformer over IO encapsulating the window -- manager state -newtype X a = X (StateT XState IO a) - deriving (Functor, Monad, MonadIO, MonadState XState) +newtype X a = X (ReaderT XConf (StateT XState IO) a) + deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf) -- | Run the X monad, given a chunk of X monad code, and an initial state -- Return the result, and final state -runX :: XState -> X a -> IO () -runX st (X a) = runStateT a st >> return () +runX :: XConf -> XState -> X a -> IO () +runX c st (X a) = runStateT (runReaderT a c) st >> return () -- --------------------------------------------------------------------- -- Convenient wrappers to state -- | Run a monad action with the current display settings withDisplay :: (Display -> X ()) -> X () -withDisplay f = gets display >>= f +withDisplay f = asks display >>= f -- | True if the given window is the root window isRoot :: Window -> X Bool -isRoot w = liftM (w==) (gets theRoot) +isRoot w = liftM (w==) (asks theRoot) ------------------------------------------------------------------------ -- Layout handling |