From 20c6b4b6684a7232021c0905bccc44f5946cb5d3 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Mon, 29 Oct 2007 19:48:23 +0100 Subject: cleaner version of main/config inversion. darcs-hash:20071029184823-72aca-5647e07a0bde65cf7e1d49a1613fb9e4210c6aa5 --- EventLoop.hs | 65 +++++++++++++++++++++++++++------------------- Main.hs | 83 +++++++++++++++++++++++++---------------------------------- Main.hs-boot | 4 --- Operations.hs | 9 ++++--- XMonad.hs | 3 +++ 5 files changed, 82 insertions(+), 82 deletions(-) diff --git a/EventLoop.hs b/EventLoop.hs index c6658db..eec62fd 100644 --- a/EventLoop.hs +++ b/EventLoop.hs @@ -12,7 +12,7 @@ -- ----------------------------------------------------------------------------- -module EventLoop ( makeMain ) where +module EventLoop ( makeMain, XMonadConfig(..) ) where import Data.Bits import qualified Data.Map as M @@ -27,32 +27,42 @@ import Graphics.X11.Xlib hiding (refreshKeyboardMapping) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama (getScreenInfo) -import XMonad +import XMonad hiding ( logHook, borderWidth ) +import qualified XMonad ( logHook, borderWidth ) import StackSet (new, floating, member) import qualified StackSet as W import Operations import System.IO +data XMonadConfig l = 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 :: String -> String -> Layout Window -> [String] -> [(Int,Int,Int,Int)] - -> M.Map (ButtonMask,KeySym) (X ()) -> M.Map (ButtonMask, Button) (Window -> X ()) - -> Dimension -> X () -> IO () -makeMain normalBorderColor focusedBorderColor layoutHook workspaces - defaultGaps keys mouseBindings borderWidth logHook = do +makeMain :: LayoutClass l Window => XMonadConfig l -> IO () +makeMain xmc = do dpy <- openDisplay "" let dflt = defaultScreen dpy rootw <- rootWindow dpy dflt xinesc <- getScreenInfo dpy - nbc <- initColor dpy normalBorderColor - fbc <- initColor dpy focusedBorderColor + nbc <- initColor dpy $ normalBorderColor xmc + fbc <- initColor dpy $ focusedBorderColor xmc hSetBuffering stdout NoBuffering args <- getArgs - let initialWinset = new layoutHook workspaces $ zipWith SD xinesc gaps + let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps maybeRead s = case reads s of [(x, "")] -> Just x @@ -61,13 +71,16 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces winset = fromMaybe initialWinset $ do ("--resume" : s : _) <- return args ws <- maybeRead s - return . W.ensureTags layoutHook workspaces - $ W.mapLayout (fromMaybe layoutHook . maybeRead) ws + return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc) + $ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws - gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0) + gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0) cf = XConf { display = dpy + , XMonad.logHook = logHook xmc + , XMonad.borderWidth = borderWidth xmc + , terminal = defaultTerminal xmc , theRoot = rootw , normalBorder = nbc , focusedBorder = fbc } @@ -87,8 +100,8 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces allocaXEvent $ \e -> runX cf st $ do - grabKeys keys - grabButtons mouseBindings + grabKeys xmc + grabButtons xmc io $ sync dpy False @@ -124,7 +137,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) | t == keyPress = withDisplay $ \dpy -> do s <- io $ keycodeToKeysym dpy code 0 - userCode $ whenJust (M.lookup (cleanMask m,s) keys) id + userCode $ whenJust (M.lookup (cleanMask m,s) (keys xmc)) id -- manage a new window handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do @@ -148,7 +161,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces -- set keyboard mapping handle e@(MappingNotifyEvent {}) = do io $ refreshKeyboardMapping e - when (ev_request e == mappingKeyboard) (grabKeys keys) + when (ev_request e == mappingKeyboard) (grabKeys xmc) -- handle button release, which may finish dragging. handle e@(ButtonEvent {ev_event_type = t}) @@ -172,7 +185,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces -- If it's the root window, then it's something we -- grabbed in grabButtons. Otherwise, it's click-to-focus. isr <- isRoot w - if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) mouseBindings) ($ ev_subwindow e) + if isr then userCode $ whenJust (M.lookup (cleanMask (ev_state e), b) $ mouseBindings xmc) ($ ev_subwindow e) else focus w sendMessage e -- Always send button events. @@ -199,7 +212,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces , wc_y = ev_y e , wc_width = ev_width e , wc_height = ev_height e - , wc_border_width = fromIntegral borderWidth + , wc_border_width = fromIntegral (borderWidth xmc) , wc_sibling = ev_above e , wc_stack_mode = ev_detail e } when (member w ws) (float w) @@ -216,7 +229,7 @@ makeMain normalBorderColor focusedBorderColor layoutHook workspaces -- property notify handle PropertyEvent { ev_event_type = t, ev_atom = a } - | t == propertyNotify && a == wM_NAME = userCode logHook + | t == propertyNotify && a == wM_NAME = userCode $ logHook xmc handle e = broadcastMessage e -- trace (eventName e) -- ignoring @@ -243,22 +256,22 @@ scan dpy rootw = do && (wa_map_state wa == waIsViewable || ic) -- | Grab the keys back -grabKeys :: M.Map (ButtonMask,KeySym) (X ()) -> X () -grabKeys keys = do +grabKeys :: XMonadConfig l -> X () +grabKeys xmc = do XConf { display = dpy, theRoot = rootw } <- ask let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync io $ ungrabKey dpy anyKey anyModifier rootw - forM_ (M.keys keys) $ \(mask,sym) -> do + forM_ (M.keys $ keys xmc) $ \(mask,sym) -> do kc <- io $ keysymToKeycode dpy sym -- "If the specified KeySym is not defined for any KeyCode, -- XKeysymToKeycode() returns zero." when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers -- | XXX comment me -grabButtons :: M.Map (ButtonMask, Button) (Window -> X ()) -> X () -grabButtons mouseBindings = do +grabButtons :: XMonadConfig l -> X () +grabButtons xmc = do XConf { display = dpy, theRoot = rootw } <- ask let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask grabModeAsync grabModeSync none none io $ ungrabButton dpy anyButton anyModifier rootw - mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys mouseBindings) + mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) extraModifiers) (M.keys $ mouseBindings xmc) diff --git a/Main.hs b/Main.hs index f3defcd..8cdd0b0 100644 --- a/Main.hs +++ b/Main.hs @@ -19,7 +19,8 @@ module Main where -- -- Useful imports -- -import XMonad +import Control.Monad.Reader ( asks ) +import XMonad hiding ( logHook, borderWidth ) import Operations import qualified StackSet as W import Data.Ratio @@ -27,7 +28,8 @@ import Data.Bits ((.|.)) import qualified Data.Map as M import System.Exit import Graphics.X11.Xlib -import EventLoop +import EventLoop hiding ( workspaces ) +import qualified EventLoop ( workspaces ) -- % Extension-provided imports @@ -67,17 +69,6 @@ modMask = mod1Mask numlockMask :: KeyMask numlockMask = mod2Mask --- | Width of the window border in pixels. --- -borderWidth :: Dimension -borderWidth = 1 - --- | Border colors for unfocused and focused windows, respectively. --- -normalBorderColor, focusedBorderColor :: String -normalBorderColor = "#dddddd" -focusedBorderColor = "#ff0000" - -- | Default offset of drawable screen boundaries from each physical -- screen. Anything non-zero here will leave a gap of that many pixels -- on the given edge, on the that screen. A useful gap at top of screen @@ -90,8 +81,8 @@ focusedBorderColor = "#ff0000" -- -- Fields are: top, bottom, left, right. -- -defaultGaps :: [(Int,Int,Int,Int)] -defaultGaps = [(0,0,0,0)] -- 15 for default dzen font +--defaultGaps :: [(Int,Int,Int,Int)] + ------------------------------------------------------------------------ -- Window rules @@ -158,42 +149,15 @@ layouts = [ Layout tiled -- Percent of screen to increment by when resizing panes delta = 3%100 --- | 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 Window -layoutHook = Layout $ Select layouts - -- | Register with xmonad a list of layouts whose state we can preserve over restarts. -- There is typically no need to modify this list, the defaults are fine. -- serialisedLayouts :: [Layout Window] -serialisedLayouts = layoutHook : layouts - ------------------------------------------------------------------------- --- Logging - --- | 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 :: X () -logHook = return () +serialisedLayouts = Layout (layoutHook defaultConfig) : layouts ------------------------------------------------------------------------ -- Key bindings: --- | The preferred terminal program, which is used in a binding below and by --- certain contrib modules. -terminal :: String -terminal = "xterm" - -- | The xmonad key bindings. Add, modify or remove key bindings here. -- -- (The comment formatting character is used when generating the manpage) @@ -201,13 +165,13 @@ terminal = "xterm" keys :: M.Map (KeyMask, KeySym) (X ()) keys = M.fromList $ -- launching and killing programs - [ ((modMask .|. shiftMask, xK_Return), spawn terminal) -- %! Launch terminal + [ ((modMask .|. shiftMask, xK_Return), asks terminal >>= spawn) -- %! Launch terminal , ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %! Reset the layouts on the current workspace to default + , ((modMask .|. shiftMask, xK_space ), setLayout $ layoutHook defaultConfig) -- %! Reset the layouts on the current workspace to default , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size @@ -234,7 +198,7 @@ keys = M.fromList $ , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area -- toggle the status bar gap - , ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap + , ((modMask , xK_b ), modifyGap (\i n -> let x = (defaultGaps defaultConfig ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap -- quit, or restart , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad @@ -274,9 +238,32 @@ mouseBindings = M.fromList $ -- % Extension-provided definitions +defaultConfig :: XMonadConfig Select +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 = Select layouts + , 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 () + } -- % The main function main :: IO () -main = makeMain normalBorderColor focusedBorderColor layoutHook workspaces - defaultGaps keys mouseBindings borderWidth logHook +main = makeMain defaultConfig diff --git a/Main.hs-boot b/Main.hs-boot index 046b627..becb178 100644 --- a/Main.hs-boot +++ b/Main.hs-boot @@ -1,11 +1,7 @@ module Main where -import Graphics.X11.Xlib.Types (Dimension) import Graphics.X11.Xlib (KeyMask,Window) import XMonad -borderWidth :: Dimension numlockMask :: KeyMask workspaces :: [WorkspaceId] -logHook :: X () manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet) serialisedLayouts :: [Layout Window] -terminal :: String diff --git a/Operations.hs b/Operations.hs index 8dbb5b4..ae5cd39 100644 --- a/Operations.hs +++ b/Operations.hs @@ -37,7 +37,7 @@ import Graphics.X11.Xlib import Graphics.X11.Xinerama (getScreenInfo) import Graphics.X11.Xlib.Extras -import {-# SOURCE #-} Main (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts) +import {-# SOURCE #-} Main (manageHook,numlockMask,serialisedLayouts) -- --------------------------------------------------------------------- -- | @@ -170,7 +170,7 @@ windows f = do whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc setTopFocus - userCode logHook + asks logHook >>= userCode -- io performGC -- really helps, but seems to trigger GC bugs? -- hide every window that was potentially visible before, but is not @@ -214,7 +214,8 @@ setInitialProperties :: Window -> X () setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do setWMState w iconicState io $ selectInput d w $ clientMask - io $ setWindowBorderWidth d w borderWidth + bw <- asks borderWidth + io $ setWindowBorderWidth d w bw -- we must initially set the color of new windows, to maintain invariants -- required by the border setting in 'windows' io $ setWindowBorder d w nb @@ -543,11 +544,11 @@ floatLocation :: Window -> X (ScreenId, W.RationalRect) floatLocation w = withDisplay $ \d -> do ws <- gets windowset wa <- io $ getWindowAttributes d w + bw <- fi `fmap` asks borderWidth -- XXX horrible let sc = fromMaybe (W.current ws) $ find (pointWithin (fi $ wa_x wa) (fi $ wa_y wa) . screenRect . W.screenDetail) $ W.screens ws sr = screenRect . W.screenDetail $ sc - bw = fi borderWidth rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)) ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)) (fi (wa_width wa + bw*2) % fi (rect_width sr)) diff --git a/XMonad.hs b/XMonad.hs index fc06885..df0d78a 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -50,7 +50,10 @@ data XState = XState , dragging :: !(Maybe (Position -> Position -> X (), X ())) } data XConf = XConf { display :: Display -- ^ the X11 display + , logHook :: !(X ()) -- ^ the loghook function + , 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 -- cgit v1.2.3