Store user configuration in XConf

This commit is contained in:
Spencer Janssen 2007-11-01 07:23:08 +00:00
parent 3789f37f25
commit e50927ffc0
4 changed files with 54 additions and 55 deletions

View File

@ -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

54
Main.hs
View File

@ -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

View File

@ -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

View File

@ -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