Add XConf for values that don't change.

darcs-hash:20070430054715-a5988-a74f5e2868f47443a69b0cd821fa690e43a4a7e1

3 files changed, 35 insertions, 25 deletions

diff --git a/Main.hs b/Main.hs
index e1d5c90..00f1948 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/XMonad.hs b/XMonad.hs
index 93265a8..5ea0c0a 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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