summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSpencer Janssen <sjanssen@cse.unl.edu>2007-04-30 07:47:15 +0200
committerSpencer Janssen <sjanssen@cse.unl.edu>2007-04-30 07:47:15 +0200
commitbf5fefaac019d75d100d7e02bee48d03c90260aa (patch)
tree1a20f535ae3c91f51e7483a31301783bf5364214
parent5b66269e136b49ed72c16c7b278c59fed9c18998 (diff)
downloadmetatile-bf5fefaac019d75d100d7e02bee48d03c90260aa.tar
metatile-bf5fefaac019d75d100d7e02bee48d03c90260aa.zip
Add XConf for values that don't change.
darcs-hash:20070430054715-a5988-a74f5e2868f47443a69b0cd821fa690e43a4a7e1
-rw-r--r--Main.hs16
-rw-r--r--Operations.hs20
-rw-r--r--XMonad.hs24
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