From b7e7fa2399db8c05fdcf0edf9189dfefaa904cef Mon Sep 17 00:00:00 2001 From: Spencer Janssen Date: Thu, 1 Nov 2007 08:23:08 +0100 Subject: Store user configuration in XConf darcs-hash:20071101072308-a5988-e5a5231e3adcff8f03ebdab37721b19c0e19fc00 --- EventLoop.hs | 29 +++++++---------------------- Main.hs | 54 +++++++++++++++++++++++++++--------------------------- Operations.hs | 6 +++--- XMonad.hs | 20 +++++++++++++++++--- 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 -- cgit v1.2.3