Store user configuration in XConf

darcs-hash:20071101072308-a5988-e5a5231e3adcff8f03ebdab37721b19c0e19fc00

4 files changed, 54 insertions, 55 deletions

diff --git a/EventLoop.hs b/EventLoop.hs
index 78e75b7..719edb0 100644
--- a/EventLoop.hs
+++ b/EventLoop.hs
@@ -13,7 +13,7 @@
 --
 -----------------------------------------------------------------------------
 
-module EventLoop ( makeMain, XMonadConfig(..) ) where
+module EventLoop (makeMain) where
 
 import Data.Bits
 import qualified Data.Map as M
@@ -28,31 +28,17 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
 import Graphics.X11.Xlib.Extras
 import Graphics.X11.Xinerama    (getScreenInfo)
 
-import XMonad hiding ( logHook, borderWidth )
-import qualified XMonad ( logHook, borderWidth )
+import XMonad
 import StackSet (new, floating, member)
 import qualified StackSet as W
 import Operations
 
 import System.IO
 
-data XMonadConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
-                        XMonadConfig { normalBorderColor :: !String
-                                     , focusedBorderColor :: !String
-                                     , defaultTerminal :: !String
-                                     , layoutHook :: !(l Window)
-                                     , workspaces :: ![String]
-                                     , defaultGaps :: ![(Int,Int,Int,Int)]
-                                     , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
-                                     , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
-                                     , borderWidth :: !Dimension
-                                     , logHook :: !(X ())
-                                     }
-
 -- |
 -- The main entry point
 --
-makeMain :: XMonadConfig -> IO ()
+makeMain :: XConfig -> IO ()
 makeMain xmc = do
     dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
@@ -64,7 +50,7 @@ makeMain xmc = do
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
-    let (layout, lreads) = case xmc of XMonadConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
+    let (layout, lreads) = case xmc of XConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
         initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
 
         maybeRead reads' s = case reads' s of
@@ -81,8 +67,7 @@ makeMain xmc = do
 
         cf = XConf
             { display       = dpy
-            , XMonad.logHook = logHook xmc
-            , XMonad.borderWidth = borderWidth xmc
+            , config        = xmc
             , terminal      = defaultTerminal xmc
             , theRoot       = rootw
             , normalBorder  = nbc
@@ -259,7 +244,7 @@ scan dpy rootw = do
                          && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
-grabKeys :: XMonadConfig -> X ()
+grabKeys :: XConfig -> X ()
 grabKeys xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
@@ -271,7 +256,7 @@ grabKeys xmc = do
          when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
 
 -- | XXX comment me
-grabButtons :: XMonadConfig -> X ()
+grabButtons :: XConfig -> X ()
 grabButtons xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
diff --git a/Main.hs b/Main.hs
index f38eda6..05cad2d 100644
--- a/Main.hs
+++ b/Main.hs
@@ -20,7 +20,8 @@ module Main where
 -- Useful imports
 --
 import Control.Monad.Reader ( asks )
-import XMonad hiding ( logHook, borderWidth )
+import XMonad hiding (workspaces)
+import qualified XMonad (workspaces)
 import Layouts
 import Operations
 import qualified StackSet as W
@@ -29,8 +30,7 @@ import Data.Bits ((.|.))
 import qualified Data.Map as M
 import System.Exit
 import Graphics.X11.Xlib
-import EventLoop hiding ( workspaces )
-import qualified EventLoop ( workspaces )
+import EventLoop
 
 -- % Extension-provided imports
 
@@ -230,30 +230,30 @@ mouseBindings = M.fromList $
 
 -- % Extension-provided definitions
 
-defaultConfig :: XMonadConfig
-defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels.
-                             , EventLoop.workspaces = workspaces
-                             , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
-                             -- | The top level layout switcher. Most users will not need to modify this binding.
-                             --
-                             -- By default, we simply switch between the layouts listed in `layouts'
-                             -- above, but you may program your own selection behaviour here. Layout
-                             -- transformers, for example, would be hooked in here.
-                             --
-                             , layoutHook = layout
-                             , defaultTerminal = "xterm" -- The preferred terminal program.
-                             , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
-                             , focusedBorderColor = "#ff0000" -- Border color for focused windows.
-                             , EventLoop.keys = Main.keys
-                             , EventLoop.mouseBindings = Main.mouseBindings
-                             -- | Perform an arbitrary action on each internal state change or X event.
-                             -- Examples include:
-                             --      * do nothing
-                             --      * log the state to stdout
-                             --
-                             -- See the 'DynamicLog' extension for examples.
-                             , logHook = return ()
-                             }
+defaultConfig :: XConfig
+defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixels.
+                        , XMonad.workspaces = workspaces
+                        , defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
+                        -- | The top level layout switcher. Most users will not need to modify this binding.
+                        --
+                        -- By default, we simply switch between the layouts listed in `layouts'
+                        -- above, but you may program your own selection behaviour here. Layout
+                        -- transformers, for example, would be hooked in here.
+                        --
+                        , layoutHook = layout
+                        , defaultTerminal = "xterm" -- The preferred terminal program.
+                        , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
+                        , focusedBorderColor = "#ff0000" -- Border color for focused windows.
+                        , XMonad.keys = Main.keys
+                        , XMonad.mouseBindings = Main.mouseBindings
+                        -- | Perform an arbitrary action on each internal state change or X event.
+                        -- Examples include:
+                        --      * do nothing
+                        --      * log the state to stdout
+                        --
+                        -- See the 'DynamicLog' extension for examples.
+                        , logHook = return ()
+                        }
 
 -- % The main function
 
diff --git a/Operations.hs b/Operations.hs
index 929ca9d..9799803 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -167,7 +167,7 @@ windows f = do
 
     whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
     setTopFocus
-    asks logHook >>= userCode
+    asks (logHook . config) >>= userCode
     -- io performGC -- really helps, but seems to trigger GC bugs?
 
     -- hide every window that was potentially visible before, but is not
@@ -211,7 +211,7 @@ setInitialProperties :: Window -> X ()
 setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
     setWMState w iconicState
     io $ selectInput d w $ clientMask
-    bw <- asks borderWidth
+    bw <- asks (borderWidth . config)
     io $ setWindowBorderWidth d w bw
     -- we must initially set the color of new windows, to maintain invariants
     -- required by the border setting in 'windows'
@@ -388,7 +388,7 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect)
 floatLocation w = withDisplay $ \d -> do
     ws <- gets windowset
     wa <- io $ getWindowAttributes d w
-    bw <- fi `fmap` asks borderWidth
+    bw <- fi `fmap` asks (borderWidth . config)
 
     -- XXX horrible
     let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws
diff --git a/XMonad.hs b/XMonad.hs
index 59f81ff..b30b5a9 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -16,7 +16,7 @@
 -----------------------------------------------------------------------------
 
 module XMonad (
-    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..),
+    X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..),
     Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
     runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
     atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
@@ -46,15 +46,29 @@ data XState = XState
     , mapped       :: !(S.Set Window)      -- ^ the Set of mapped windows
     , waitingUnmap :: !(M.Map Window Int)  -- ^ the number of expected UnmapEvents
     , dragging     :: !(Maybe (Position -> Position -> X (), X ())) }
+
 data XConf = XConf
     { display       :: Display        -- ^ the X11 display
-    , logHook       :: !(X ())        -- ^ the loghook function
+    , config        :: !XConfig       -- ^ initial user configuration
     , terminal      :: !String        -- ^ the user's preferred terminal
     , theRoot       :: !Window        -- ^ the root window
-    , borderWidth   :: !Dimension     -- ^ the preferred border width
     , normalBorder  :: !Pixel         -- ^ border color of unfocused windows
     , focusedBorder :: !Pixel     }   -- ^ border color of the focused window
 
+-- todo, better name
+data XConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
+                        XConfig { normalBorderColor :: !String
+                                     , focusedBorderColor :: !String
+                                     , defaultTerminal :: !String
+                                     , layoutHook :: !(l Window)
+                                     , workspaces :: ![String]
+                                     , defaultGaps :: ![(Int,Int,Int,Int)]
+                                     , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+                                     , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+                                     , borderWidth :: !Dimension
+                                     , logHook :: !(X ())
+                                     }
+
 type WindowSet   = StackSet  WorkspaceId (Layout Window) Window ScreenId ScreenDetail
 type WindowSpace = Workspace WorkspaceId (Layout Window) Window